├── LICENSE
├── bindings
├── bindings.ml
└── dune
├── config
├── discover.ml
└── dune
├── doc
├── dune
└── index.mld
├── dune-project
├── examples
├── hello-world
│ ├── dune
│ └── hello_world.ml
├── interactive-shell
│ ├── dune
│ └── interactive_shell.ml
└── turtle-program
│ ├── dune.disabled
│ └── turtle_program.ml
├── guile.opam
├── lib
├── dune
├── guile.ml
├── guile.mli
├── guile_stubs.c
└── raw.ml
├── readme.md
└── stubgen
├── bindings_c_gen.ml
└── dune
/LICENSE:
--------------------------------------------------------------------------------
1 | GNU GENERAL PUBLIC LICENSE
2 | Version 3, 29 June 2007
3 |
4 | Copyright (C) 2007 Free Software Foundation, Inc.
5 | Everyone is permitted to copy and distribute verbatim copies
6 | of this license document, but changing it is not allowed.
7 |
8 | Preamble
9 |
10 | The GNU General Public License is a free, copyleft license for
11 | software and other kinds of works.
12 |
13 | The licenses for most software and other practical works are designed
14 | to take away your freedom to share and change the works. By contrast,
15 | the GNU General Public License is intended to guarantee your freedom to
16 | share and change all versions of a program--to make sure it remains free
17 | software for all its users. We, the Free Software Foundation, use the
18 | GNU General Public License for most of our software; it applies also to
19 | any other work released this way by its authors. You can apply it to
20 | your programs, too.
21 |
22 | When we speak of free software, we are referring to freedom, not
23 | price. Our General Public Licenses are designed to make sure that you
24 | have the freedom to distribute copies of free software (and charge for
25 | them if you wish), that you receive source code or can get it if you
26 | want it, that you can change the software or use pieces of it in new
27 | free programs, and that you know you can do these things.
28 |
29 | To protect your rights, we need to prevent others from denying you
30 | these rights or asking you to surrender the rights. Therefore, you have
31 | certain responsibilities if you distribute copies of the software, or if
32 | you modify it: responsibilities to respect the freedom of others.
33 |
34 | For example, if you distribute copies of such a program, whether
35 | gratis or for a fee, you must pass on to the recipients the same
36 | freedoms that you received. You must make sure that they, too, receive
37 | or can get the source code. And you must show them these terms so they
38 | know their rights.
39 |
40 | Developers that use the GNU GPL protect your rights with two steps:
41 | (1) assert copyright on the software, and (2) offer you this License
42 | giving you legal permission to copy, distribute and/or modify it.
43 |
44 | For the developers' and authors' protection, the GPL clearly explains
45 | that there is no warranty for this free software. For both users' and
46 | authors' sake, the GPL requires that modified versions be marked as
47 | changed, so that their problems will not be attributed erroneously to
48 | authors of previous versions.
49 |
50 | Some devices are designed to deny users access to install or run
51 | modified versions of the software inside them, although the manufacturer
52 | can do so. This is fundamentally incompatible with the aim of
53 | protecting users' freedom to change the software. The systematic
54 | pattern of such abuse occurs in the area of products for individuals to
55 | use, which is precisely where it is most unacceptable. Therefore, we
56 | have designed this version of the GPL to prohibit the practice for those
57 | products. If such problems arise substantially in other domains, we
58 | stand ready to extend this provision to those domains in future versions
59 | of the GPL, as needed to protect the freedom of users.
60 |
61 | Finally, every program is threatened constantly by software patents.
62 | States should not allow patents to restrict development and use of
63 | software on general-purpose computers, but in those that do, we wish to
64 | avoid the special danger that patents applied to a free program could
65 | make it effectively proprietary. To prevent this, the GPL assures that
66 | patents cannot be used to render the program non-free.
67 |
68 | The precise terms and conditions for copying, distribution and
69 | modification follow.
70 |
71 | TERMS AND CONDITIONS
72 |
73 | 0. Definitions.
74 |
75 | "This License" refers to version 3 of the GNU General Public License.
76 |
77 | "Copyright" also means copyright-like laws that apply to other kinds of
78 | works, such as semiconductor masks.
79 |
80 | "The Program" refers to any copyrightable work licensed under this
81 | License. Each licensee is addressed as "you". "Licensees" and
82 | "recipients" may be individuals or organizations.
83 |
84 | To "modify" a work means to copy from or adapt all or part of the work
85 | in a fashion requiring copyright permission, other than the making of an
86 | exact copy. The resulting work is called a "modified version" of the
87 | earlier work or a work "based on" the earlier work.
88 |
89 | A "covered work" means either the unmodified Program or a work based
90 | on the Program.
91 |
92 | To "propagate" a work means to do anything with it that, without
93 | permission, would make you directly or secondarily liable for
94 | infringement under applicable copyright law, except executing it on a
95 | computer or modifying a private copy. Propagation includes copying,
96 | distribution (with or without modification), making available to the
97 | public, and in some countries other activities as well.
98 |
99 | To "convey" a work means any kind of propagation that enables other
100 | parties to make or receive copies. Mere interaction with a user through
101 | a computer network, with no transfer of a copy, is not conveying.
102 |
103 | An interactive user interface displays "Appropriate Legal Notices"
104 | to the extent that it includes a convenient and prominently visible
105 | feature that (1) displays an appropriate copyright notice, and (2)
106 | tells the user that there is no warranty for the work (except to the
107 | extent that warranties are provided), that licensees may convey the
108 | work under this License, and how to view a copy of this License. If
109 | the interface presents a list of user commands or options, such as a
110 | menu, a prominent item in the list meets this criterion.
111 |
112 | 1. Source Code.
113 |
114 | The "source code" for a work means the preferred form of the work
115 | for making modifications to it. "Object code" means any non-source
116 | form of a work.
117 |
118 | A "Standard Interface" means an interface that either is an official
119 | standard defined by a recognized standards body, or, in the case of
120 | interfaces specified for a particular programming language, one that
121 | is widely used among developers working in that language.
122 |
123 | The "System Libraries" of an executable work include anything, other
124 | than the work as a whole, that (a) is included in the normal form of
125 | packaging a Major Component, but which is not part of that Major
126 | Component, and (b) serves only to enable use of the work with that
127 | Major Component, or to implement a Standard Interface for which an
128 | implementation is available to the public in source code form. A
129 | "Major Component", in this context, means a major essential component
130 | (kernel, window system, and so on) of the specific operating system
131 | (if any) on which the executable work runs, or a compiler used to
132 | produce the work, or an object code interpreter used to run it.
133 |
134 | The "Corresponding Source" for a work in object code form means all
135 | the source code needed to generate, install, and (for an executable
136 | work) run the object code and to modify the work, including scripts to
137 | control those activities. However, it does not include the work's
138 | System Libraries, or general-purpose tools or generally available free
139 | programs which are used unmodified in performing those activities but
140 | which are not part of the work. For example, Corresponding Source
141 | includes interface definition files associated with source files for
142 | the work, and the source code for shared libraries and dynamically
143 | linked subprograms that the work is specifically designed to require,
144 | such as by intimate data communication or control flow between those
145 | subprograms and other parts of the work.
146 |
147 | The Corresponding Source need not include anything that users
148 | can regenerate automatically from other parts of the Corresponding
149 | Source.
150 |
151 | The Corresponding Source for a work in source code form is that
152 | same work.
153 |
154 | 2. Basic Permissions.
155 |
156 | All rights granted under this License are granted for the term of
157 | copyright on the Program, and are irrevocable provided the stated
158 | conditions are met. This License explicitly affirms your unlimited
159 | permission to run the unmodified Program. The output from running a
160 | covered work is covered by this License only if the output, given its
161 | content, constitutes a covered work. This License acknowledges your
162 | rights of fair use or other equivalent, as provided by copyright law.
163 |
164 | You may make, run and propagate covered works that you do not
165 | convey, without conditions so long as your license otherwise remains
166 | in force. You may convey covered works to others for the sole purpose
167 | of having them make modifications exclusively for you, or provide you
168 | with facilities for running those works, provided that you comply with
169 | the terms of this License in conveying all material for which you do
170 | not control copyright. Those thus making or running the covered works
171 | for you must do so exclusively on your behalf, under your direction
172 | and control, on terms that prohibit them from making any copies of
173 | your copyrighted material outside their relationship with you.
174 |
175 | Conveying under any other circumstances is permitted solely under
176 | the conditions stated below. Sublicensing is not allowed; section 10
177 | makes it unnecessary.
178 |
179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
180 |
181 | No covered work shall be deemed part of an effective technological
182 | measure under any applicable law fulfilling obligations under article
183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or
184 | similar laws prohibiting or restricting circumvention of such
185 | measures.
186 |
187 | When you convey a covered work, you waive any legal power to forbid
188 | circumvention of technological measures to the extent such circumvention
189 | is effected by exercising rights under this License with respect to
190 | the covered work, and you disclaim any intention to limit operation or
191 | modification of the work as a means of enforcing, against the work's
192 | users, your or third parties' legal rights to forbid circumvention of
193 | technological measures.
194 |
195 | 4. Conveying Verbatim Copies.
196 |
197 | You may convey verbatim copies of the Program's source code as you
198 | receive it, in any medium, provided that you conspicuously and
199 | appropriately publish on each copy an appropriate copyright notice;
200 | keep intact all notices stating that this License and any
201 | non-permissive terms added in accord with section 7 apply to the code;
202 | keep intact all notices of the absence of any warranty; and give all
203 | recipients a copy of this License along with the Program.
204 |
205 | You may charge any price or no price for each copy that you convey,
206 | and you may offer support or warranty protection for a fee.
207 |
208 | 5. Conveying Modified Source Versions.
209 |
210 | You may convey a work based on the Program, or the modifications to
211 | produce it from the Program, in the form of source code under the
212 | terms of section 4, provided that you also meet all of these conditions:
213 |
214 | a) The work must carry prominent notices stating that you modified
215 | it, and giving a relevant date.
216 |
217 | b) The work must carry prominent notices stating that it is
218 | released under this License and any conditions added under section
219 | 7. This requirement modifies the requirement in section 4 to
220 | "keep intact all notices".
221 |
222 | c) You must license the entire work, as a whole, under this
223 | License to anyone who comes into possession of a copy. This
224 | License will therefore apply, along with any applicable section 7
225 | additional terms, to the whole of the work, and all its parts,
226 | regardless of how they are packaged. This License gives no
227 | permission to license the work in any other way, but it does not
228 | invalidate such permission if you have separately received it.
229 |
230 | d) If the work has interactive user interfaces, each must display
231 | Appropriate Legal Notices; however, if the Program has interactive
232 | interfaces that do not display Appropriate Legal Notices, your
233 | work need not make them do so.
234 |
235 | A compilation of a covered work with other separate and independent
236 | works, which are not by their nature extensions of the covered work,
237 | and which are not combined with it such as to form a larger program,
238 | in or on a volume of a storage or distribution medium, is called an
239 | "aggregate" if the compilation and its resulting copyright are not
240 | used to limit the access or legal rights of the compilation's users
241 | beyond what the individual works permit. Inclusion of a covered work
242 | in an aggregate does not cause this License to apply to the other
243 | parts of the aggregate.
244 |
245 | 6. Conveying Non-Source Forms.
246 |
247 | You may convey a covered work in object code form under the terms
248 | of sections 4 and 5, provided that you also convey the
249 | machine-readable Corresponding Source under the terms of this License,
250 | in one of these ways:
251 |
252 | a) Convey the object code in, or embodied in, a physical product
253 | (including a physical distribution medium), accompanied by the
254 | Corresponding Source fixed on a durable physical medium
255 | customarily used for software interchange.
256 |
257 | b) Convey the object code in, or embodied in, a physical product
258 | (including a physical distribution medium), accompanied by a
259 | written offer, valid for at least three years and valid for as
260 | long as you offer spare parts or customer support for that product
261 | model, to give anyone who possesses the object code either (1) a
262 | copy of the Corresponding Source for all the software in the
263 | product that is covered by this License, on a durable physical
264 | medium customarily used for software interchange, for a price no
265 | more than your reasonable cost of physically performing this
266 | conveying of source, or (2) access to copy the
267 | Corresponding Source from a network server at no charge.
268 |
269 | c) Convey individual copies of the object code with a copy of the
270 | written offer to provide the Corresponding Source. This
271 | alternative is allowed only occasionally and noncommercially, and
272 | only if you received the object code with such an offer, in accord
273 | with subsection 6b.
274 |
275 | d) Convey the object code by offering access from a designated
276 | place (gratis or for a charge), and offer equivalent access to the
277 | Corresponding Source in the same way through the same place at no
278 | further charge. You need not require recipients to copy the
279 | Corresponding Source along with the object code. If the place to
280 | copy the object code is a network server, the Corresponding Source
281 | may be on a different server (operated by you or a third party)
282 | that supports equivalent copying facilities, provided you maintain
283 | clear directions next to the object code saying where to find the
284 | Corresponding Source. Regardless of what server hosts the
285 | Corresponding Source, you remain obligated to ensure that it is
286 | available for as long as needed to satisfy these requirements.
287 |
288 | e) Convey the object code using peer-to-peer transmission, provided
289 | you inform other peers where the object code and Corresponding
290 | Source of the work are being offered to the general public at no
291 | charge under subsection 6d.
292 |
293 | A separable portion of the object code, whose source code is excluded
294 | from the Corresponding Source as a System Library, need not be
295 | included in conveying the object code work.
296 |
297 | A "User Product" is either (1) a "consumer product", which means any
298 | tangible personal property which is normally used for personal, family,
299 | or household purposes, or (2) anything designed or sold for incorporation
300 | into a dwelling. In determining whether a product is a consumer product,
301 | doubtful cases shall be resolved in favor of coverage. For a particular
302 | product received by a particular user, "normally used" refers to a
303 | typical or common use of that class of product, regardless of the status
304 | of the particular user or of the way in which the particular user
305 | actually uses, or expects or is expected to use, the product. A product
306 | is a consumer product regardless of whether the product has substantial
307 | commercial, industrial or non-consumer uses, unless such uses represent
308 | the only significant mode of use of the product.
309 |
310 | "Installation Information" for a User Product means any methods,
311 | procedures, authorization keys, or other information required to install
312 | and execute modified versions of a covered work in that User Product from
313 | a modified version of its Corresponding Source. The information must
314 | suffice to ensure that the continued functioning of the modified object
315 | code is in no case prevented or interfered with solely because
316 | modification has been made.
317 |
318 | If you convey an object code work under this section in, or with, or
319 | specifically for use in, a User Product, and the conveying occurs as
320 | part of a transaction in which the right of possession and use of the
321 | User Product is transferred to the recipient in perpetuity or for a
322 | fixed term (regardless of how the transaction is characterized), the
323 | Corresponding Source conveyed under this section must be accompanied
324 | by the Installation Information. But this requirement does not apply
325 | if neither you nor any third party retains the ability to install
326 | modified object code on the User Product (for example, the work has
327 | been installed in ROM).
328 |
329 | The requirement to provide Installation Information does not include a
330 | requirement to continue to provide support service, warranty, or updates
331 | for a work that has been modified or installed by the recipient, or for
332 | the User Product in which it has been modified or installed. Access to a
333 | network may be denied when the modification itself materially and
334 | adversely affects the operation of the network or violates the rules and
335 | protocols for communication across the network.
336 |
337 | Corresponding Source conveyed, and Installation Information provided,
338 | in accord with this section must be in a format that is publicly
339 | documented (and with an implementation available to the public in
340 | source code form), and must require no special password or key for
341 | unpacking, reading or copying.
342 |
343 | 7. Additional Terms.
344 |
345 | "Additional permissions" are terms that supplement the terms of this
346 | License by making exceptions from one or more of its conditions.
347 | Additional permissions that are applicable to the entire Program shall
348 | be treated as though they were included in this License, to the extent
349 | that they are valid under applicable law. If additional permissions
350 | apply only to part of the Program, that part may be used separately
351 | under those permissions, but the entire Program remains governed by
352 | this License without regard to the additional permissions.
353 |
354 | When you convey a copy of a covered work, you may at your option
355 | remove any additional permissions from that copy, or from any part of
356 | it. (Additional permissions may be written to require their own
357 | removal in certain cases when you modify the work.) You may place
358 | additional permissions on material, added by you to a covered work,
359 | for which you have or can give appropriate copyright permission.
360 |
361 | Notwithstanding any other provision of this License, for material you
362 | add to a covered work, you may (if authorized by the copyright holders of
363 | that material) supplement the terms of this License with terms:
364 |
365 | a) Disclaiming warranty or limiting liability differently from the
366 | terms of sections 15 and 16 of this License; or
367 |
368 | b) Requiring preservation of specified reasonable legal notices or
369 | author attributions in that material or in the Appropriate Legal
370 | Notices displayed by works containing it; or
371 |
372 | c) Prohibiting misrepresentation of the origin of that material, or
373 | requiring that modified versions of such material be marked in
374 | reasonable ways as different from the original version; or
375 |
376 | d) Limiting the use for publicity purposes of names of licensors or
377 | authors of the material; or
378 |
379 | e) Declining to grant rights under trademark law for use of some
380 | trade names, trademarks, or service marks; or
381 |
382 | f) Requiring indemnification of licensors and authors of that
383 | material by anyone who conveys the material (or modified versions of
384 | it) with contractual assumptions of liability to the recipient, for
385 | any liability that these contractual assumptions directly impose on
386 | those licensors and authors.
387 |
388 | All other non-permissive additional terms are considered "further
389 | restrictions" within the meaning of section 10. If the Program as you
390 | received it, or any part of it, contains a notice stating that it is
391 | governed by this License along with a term that is a further
392 | restriction, you may remove that term. If a license document contains
393 | a further restriction but permits relicensing or conveying under this
394 | License, you may add to a covered work material governed by the terms
395 | of that license document, provided that the further restriction does
396 | not survive such relicensing or conveying.
397 |
398 | If you add terms to a covered work in accord with this section, you
399 | must place, in the relevant source files, a statement of the
400 | additional terms that apply to those files, or a notice indicating
401 | where to find the applicable terms.
402 |
403 | Additional terms, permissive or non-permissive, may be stated in the
404 | form of a separately written license, or stated as exceptions;
405 | the above requirements apply either way.
406 |
407 | 8. Termination.
408 |
409 | You may not propagate or modify a covered work except as expressly
410 | provided under this License. Any attempt otherwise to propagate or
411 | modify it is void, and will automatically terminate your rights under
412 | this License (including any patent licenses granted under the third
413 | paragraph of section 11).
414 |
415 | However, if you cease all violation of this License, then your
416 | license from a particular copyright holder is reinstated (a)
417 | provisionally, unless and until the copyright holder explicitly and
418 | finally terminates your license, and (b) permanently, if the copyright
419 | holder fails to notify you of the violation by some reasonable means
420 | prior to 60 days after the cessation.
421 |
422 | Moreover, your license from a particular copyright holder is
423 | reinstated permanently if the copyright holder notifies you of the
424 | violation by some reasonable means, this is the first time you have
425 | received notice of violation of this License (for any work) from that
426 | copyright holder, and you cure the violation prior to 30 days after
427 | your receipt of the notice.
428 |
429 | Termination of your rights under this section does not terminate the
430 | licenses of parties who have received copies or rights from you under
431 | this License. If your rights have been terminated and not permanently
432 | reinstated, you do not qualify to receive new licenses for the same
433 | material under section 10.
434 |
435 | 9. Acceptance Not Required for Having Copies.
436 |
437 | You are not required to accept this License in order to receive or
438 | run a copy of the Program. Ancillary propagation of a covered work
439 | occurring solely as a consequence of using peer-to-peer transmission
440 | to receive a copy likewise does not require acceptance. However,
441 | nothing other than this License grants you permission to propagate or
442 | modify any covered work. These actions infringe copyright if you do
443 | not accept this License. Therefore, by modifying or propagating a
444 | covered work, you indicate your acceptance of this License to do so.
445 |
446 | 10. Automatic Licensing of Downstream Recipients.
447 |
448 | Each time you convey a covered work, the recipient automatically
449 | receives a license from the original licensors, to run, modify and
450 | propagate that work, subject to this License. You are not responsible
451 | for enforcing compliance by third parties with this License.
452 |
453 | An "entity transaction" is a transaction transferring control of an
454 | organization, or substantially all assets of one, or subdividing an
455 | organization, or merging organizations. If propagation of a covered
456 | work results from an entity transaction, each party to that
457 | transaction who receives a copy of the work also receives whatever
458 | licenses to the work the party's predecessor in interest had or could
459 | give under the previous paragraph, plus a right to possession of the
460 | Corresponding Source of the work from the predecessor in interest, if
461 | the predecessor has it or can get it with reasonable efforts.
462 |
463 | You may not impose any further restrictions on the exercise of the
464 | rights granted or affirmed under this License. For example, you may
465 | not impose a license fee, royalty, or other charge for exercise of
466 | rights granted under this License, and you may not initiate litigation
467 | (including a cross-claim or counterclaim in a lawsuit) alleging that
468 | any patent claim is infringed by making, using, selling, offering for
469 | sale, or importing the Program or any portion of it.
470 |
471 | 11. Patents.
472 |
473 | A "contributor" is a copyright holder who authorizes use under this
474 | License of the Program or a work on which the Program is based. The
475 | work thus licensed is called the contributor's "contributor version".
476 |
477 | A contributor's "essential patent claims" are all patent claims
478 | owned or controlled by the contributor, whether already acquired or
479 | hereafter acquired, that would be infringed by some manner, permitted
480 | by this License, of making, using, or selling its contributor version,
481 | but do not include claims that would be infringed only as a
482 | consequence of further modification of the contributor version. For
483 | purposes of this definition, "control" includes the right to grant
484 | patent sublicenses in a manner consistent with the requirements of
485 | this License.
486 |
487 | Each contributor grants you a non-exclusive, worldwide, royalty-free
488 | patent license under the contributor's essential patent claims, to
489 | make, use, sell, offer for sale, import and otherwise run, modify and
490 | propagate the contents of its contributor version.
491 |
492 | In the following three paragraphs, a "patent license" is any express
493 | agreement or commitment, however denominated, not to enforce a patent
494 | (such as an express permission to practice a patent or covenant not to
495 | sue for patent infringement). To "grant" such a patent license to a
496 | party means to make such an agreement or commitment not to enforce a
497 | patent against the party.
498 |
499 | If you convey a covered work, knowingly relying on a patent license,
500 | and the Corresponding Source of the work is not available for anyone
501 | to copy, free of charge and under the terms of this License, through a
502 | publicly available network server or other readily accessible means,
503 | then you must either (1) cause the Corresponding Source to be so
504 | available, or (2) arrange to deprive yourself of the benefit of the
505 | patent license for this particular work, or (3) arrange, in a manner
506 | consistent with the requirements of this License, to extend the patent
507 | license to downstream recipients. "Knowingly relying" means you have
508 | actual knowledge that, but for the patent license, your conveying the
509 | covered work in a country, or your recipient's use of the covered work
510 | in a country, would infringe one or more identifiable patents in that
511 | country that you have reason to believe are valid.
512 |
513 | If, pursuant to or in connection with a single transaction or
514 | arrangement, you convey, or propagate by procuring conveyance of, a
515 | covered work, and grant a patent license to some of the parties
516 | receiving the covered work authorizing them to use, propagate, modify
517 | or convey a specific copy of the covered work, then the patent license
518 | you grant is automatically extended to all recipients of the covered
519 | work and works based on it.
520 |
521 | A patent license is "discriminatory" if it does not include within
522 | the scope of its coverage, prohibits the exercise of, or is
523 | conditioned on the non-exercise of one or more of the rights that are
524 | specifically granted under this License. You may not convey a covered
525 | work if you are a party to an arrangement with a third party that is
526 | in the business of distributing software, under which you make payment
527 | to the third party based on the extent of your activity of conveying
528 | the work, and under which the third party grants, to any of the
529 | parties who would receive the covered work from you, a discriminatory
530 | patent license (a) in connection with copies of the covered work
531 | conveyed by you (or copies made from those copies), or (b) primarily
532 | for and in connection with specific products or compilations that
533 | contain the covered work, unless you entered into that arrangement,
534 | or that patent license was granted, prior to 28 March 2007.
535 |
536 | Nothing in this License shall be construed as excluding or limiting
537 | any implied license or other defenses to infringement that may
538 | otherwise be available to you under applicable patent law.
539 |
540 | 12. No Surrender of Others' Freedom.
541 |
542 | If conditions are imposed on you (whether by court order, agreement or
543 | otherwise) that contradict the conditions of this License, they do not
544 | excuse you from the conditions of this License. If you cannot convey a
545 | covered work so as to satisfy simultaneously your obligations under this
546 | License and any other pertinent obligations, then as a consequence you may
547 | not convey it at all. For example, if you agree to terms that obligate you
548 | to collect a royalty for further conveying from those to whom you convey
549 | the Program, the only way you could satisfy both those terms and this
550 | License would be to refrain entirely from conveying the Program.
551 |
552 | 13. Use with the GNU Affero General Public License.
553 |
554 | Notwithstanding any other provision of this License, you have
555 | permission to link or combine any covered work with a work licensed
556 | under version 3 of the GNU Affero General Public License into a single
557 | combined work, and to convey the resulting work. The terms of this
558 | License will continue to apply to the part which is the covered work,
559 | but the special requirements of the GNU Affero General Public License,
560 | section 13, concerning interaction through a network will apply to the
561 | combination as such.
562 |
563 | 14. Revised Versions of this License.
564 |
565 | The Free Software Foundation may publish revised and/or new versions of
566 | the GNU General Public License from time to time. Such new versions will
567 | be similar in spirit to the present version, but may differ in detail to
568 | address new problems or concerns.
569 |
570 | Each version is given a distinguishing version number. If the
571 | Program specifies that a certain numbered version of the GNU General
572 | Public License "or any later version" applies to it, you have the
573 | option of following the terms and conditions either of that numbered
574 | version or of any later version published by the Free Software
575 | Foundation. If the Program does not specify a version number of the
576 | GNU General Public License, you may choose any version ever published
577 | by the Free Software Foundation.
578 |
579 | If the Program specifies that a proxy can decide which future
580 | versions of the GNU General Public License can be used, that proxy's
581 | public statement of acceptance of a version permanently authorizes you
582 | to choose that version for the Program.
583 |
584 | Later license versions may give you additional or different
585 | permissions. However, no additional obligations are imposed on any
586 | author or copyright holder as a result of your choosing to follow a
587 | later version.
588 |
589 | 15. Disclaimer of Warranty.
590 |
591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
599 |
600 | 16. Limitation of Liability.
601 |
602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
610 | SUCH DAMAGES.
611 |
612 | 17. Interpretation of Sections 15 and 16.
613 |
614 | If the disclaimer of warranty and limitation of liability provided
615 | above cannot be given local legal effect according to their terms,
616 | reviewing courts shall apply local law that most closely approximates
617 | an absolute waiver of all civil liability in connection with the
618 | Program, unless a warranty or assumption of liability accompanies a
619 | copy of the Program in return for a fee.
620 |
621 | END OF TERMS AND CONDITIONS
622 |
623 | How to Apply These Terms to Your New Programs
624 |
625 | If you develop a new program, and you want it to be of the greatest
626 | possible use to the public, the best way to achieve this is to make it
627 | free software which everyone can redistribute and change under these terms.
628 |
629 | To do so, attach the following notices to the program. It is safest
630 | to attach them to the start of each source file to most effectively
631 | state the exclusion of warranty; and each file should have at least
632 | the "copyright" line and a pointer to where the full notice is found.
633 |
634 |
635 | Copyright (C)
636 |
637 | This program is free software: you can redistribute it and/or modify
638 | it under the terms of the GNU General Public License as published by
639 | the Free Software Foundation, either version 3 of the License, or
640 | (at your option) any later version.
641 |
642 | This program is distributed in the hope that it will be useful,
643 | but WITHOUT ANY WARRANTY; without even the implied warranty of
644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
645 | GNU General Public License for more details.
646 |
647 | You should have received a copy of the GNU General Public License
648 | along with this program. If not, see .
649 |
650 | Also add information on how to contact you by electronic and paper mail.
651 |
652 | If the program does terminal interaction, make it output a short
653 | notice like this when it starts in an interactive mode:
654 |
655 | Copyright (C)
656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
657 | This is free software, and you are welcome to redistribute it
658 | under certain conditions; type `show c' for details.
659 |
660 | The hypothetical commands `show w' and `show c' should show the appropriate
661 | parts of the General Public License. Of course, your program's commands
662 | might be different; for a GUI interface, you would use an "about box".
663 |
664 | You should also get your employer (if you work as a programmer) or school,
665 | if any, to sign a "copyright disclaimer" for the program, if necessary.
666 | For more information on this, and how to apply and follow the GNU GPL, see
667 | .
668 |
669 | The GNU General Public License does not permit incorporating your program
670 | into proprietary programs. If your program is a subroutine library, you
671 | may consider it more useful to permit linking proprietary applications with
672 | the library. If this is what you want to do, use the GNU Lesser General
673 | Public License instead of this License. But first, please read
674 | .
675 |
--------------------------------------------------------------------------------
/bindings/bindings.ml:
--------------------------------------------------------------------------------
1 | (*
2 | gnu Guile OCaml Bindings
3 |
4 | Copyright (C) 2021 Kiran Gopinathan
5 |
6 | This program is free software: you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation, either version 3 of the License, or
9 | (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with this program. If not, see .
18 | *)
19 | [@@@warning "-50"]
20 |
21 | module Stubs = functor (T: Cstubs_structs.TYPE) -> struct
22 |
23 | let scml_bool_f = T.constant "SCM_BOOL_F" T.(intptr_t)
24 | let scml_bool_t = T.constant "SCM_BOOL_T" T.(intptr_t)
25 | let scm_eol = T.constant "SCM_EOL" T.(intptr_t)
26 | let scm_undefined = T.constant "SCM_UNDEFINED" T.(intptr_t)
27 |
28 | end
29 |
30 |
--------------------------------------------------------------------------------
/bindings/dune:
--------------------------------------------------------------------------------
1 | (library
2 | (name bindings)
3 | (public_name guile.__private__.bindings)
4 | (synopsis "Ctypes bindings to describe the GNU Guile FFI.")
5 | (libraries ctypes.stubs ctypes))
6 |
--------------------------------------------------------------------------------
/config/discover.ml:
--------------------------------------------------------------------------------
1 | (*
2 | GNU Guile OCaml Bindings
3 |
4 | Copyright (C) 2021 Kiran Gopinathan
5 |
6 | This program is free software: you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation, either version 3 of the License, or
9 | (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with this program. If not, see .
18 | *)
19 |
20 | open Base
21 | open Stdio
22 | module C = Configurator.V1
23 |
24 | let write_sexp fn list_of_str =
25 | let data = sexp_of_list sexp_of_string list_of_str |> Sexp.to_string in
26 | Out_channel.write_all fn ~data
27 |
28 | let write_flags file list_of_str =
29 | let data = String.concat list_of_str ~sep:" " in
30 | Out_channel.write_all file ~data
31 |
32 | (* -I/usr/include/guile/3.0 -lguile-3.0 -lgc -lpthread -ldl *)
33 | let () =
34 | C.main ~name:"guile" (fun c ->
35 | let default : C.Pkg_config.package_conf =
36 | { libs = ["-lguile-3.0"; "-lgc"; "-lpthread"; "-ldl"; "-lffi"]
37 | ; cflags = ["-O2"; "-Wall"; "-Wextra"; "-Wno-unused-parameter"; "-pthread";
38 | "-I/usr/include/guile/3.0";
39 | "-I/usr/include"]
40 | }
41 | in
42 | let default_ffi : C.Pkg_config.package_conf =
43 | { libs = ["-lffi"] ;
44 | cflags = ["-O2"; "-Wall"; "-Wextra"; "-Wno-unused-parameter";
45 | "-I/usr/include/guile/3.0";
46 | "-I/usr/include/x86_64-linux-gnu"; (* default ubuntu *)
47 | "-I/usr/include"] (* default ubuntu *)
48 | }
49 | in
50 | let conf =
51 | match C.Pkg_config.get c with
52 | | None -> default
53 | | Some pc ->
54 | let get_config package default =
55 | Option.value (C.Pkg_config.query pc ~package) ~default in
56 | let libffi = get_config "libffi" default_ffi in
57 | let guile = get_config "guile-3.0" default in
58 | let module P = C.Pkg_config in
59 | { libs = (libffi.P.libs @ guile.P.libs);
60 | cflags = (libffi.P.cflags @ guile.P.cflags) }
61 | in
62 | let os_type = C.ocaml_config_var_exn (C.create "") "system" in
63 | let ccopts =
64 | if Base.String.(os_type = "macosx") then [""]
65 | else ["-Wl,-no-as-needed"]
66 | in
67 | write_sexp "c_flags.sexp" conf.cflags;
68 | write_sexp "c_library_flags.sexp" conf.libs;
69 | write_sexp "ccopts.sexp" ccopts;
70 | write_flags "c_library_flags" conf.libs;
71 | write_flags "c_flags" conf.cflags)
72 |
--------------------------------------------------------------------------------
/config/dune:
--------------------------------------------------------------------------------
1 | (executable
2 | (name discover)
3 | (libraries base stdio dune-configurator))
4 |
--------------------------------------------------------------------------------
/doc/dune:
--------------------------------------------------------------------------------
1 | (documentation
2 | (package guile))
3 |
--------------------------------------------------------------------------------
/doc/index.mld:
--------------------------------------------------------------------------------
1 | {0:top Guile}
2 |
3 | Guile-ocaml is a Free Software library that provides high-level OCaml
4 | bindings to the FFI interface for GNU Guile Scheme. The aim of these
5 | bindings are to provide an easy way for OCaml developers to extend
6 | their OCaml applications with GNU Guile scheme scripting capabilities,
7 | providing simple combinators to translate terms and send queries
8 | between the two languages.
9 |
10 | {[
11 | (* initialise GNU Guile *)
12 | let () = Guile.init () in
13 | (* expose OCaml functions to Guile scheme *)
14 | let _ = Guile.Functions.register_fun1 "my-fun" ~no_opt:1
15 | (fun _ -> print_endline "hello world!"; Guile.eol) in
16 | (* start guile repl *)
17 | Guile.shell ()
18 | ]}
19 |
20 | The rest of this page will provide a simple quick-start guide to using
21 | {{:#top}Guile}. We will look at using it to build a simple turtle
22 | drawing program. Advanced users may instead want to check out the
23 | {{!Guile}API documentation}.
24 |
25 | {1 Writing a turtle drawing program with GNU Guile}
26 |
27 | For this example, we will be using OCaml's graphics library. You can
28 | find the complete project under [examples/turtle-program] on the
29 | [ocaml-guile] repo.
30 |
31 | Before we go any further, let's make sure the Guile context has been
32 | initialised:
33 |
34 | {[
35 | let () = Guile.init ()
36 | ]}
37 |
38 | Now, with that out of the way, let's get started with defining the
39 | behaviours of our turtle.
40 |
41 | The first thing we'll need is an ADT to represent the direction and movement of the turtle:
42 |
43 | {[
44 | type direction = Up | Down | Left | Right
45 |
46 | let turn_right = function Up -> Left | Left -> Down | Down -> Right | Right -> Up
47 | let turn_left = function Left -> Up | Down -> Left | Right -> Down | Up -> Right
48 |
49 | let move n (x,y) = function
50 | | Up -> (x, y + n)
51 | | Down -> (x, y - n)
52 | | Left -> (x - n, y)
53 | | Right -> (x + n, y)
54 | ]}
55 |
56 | Now, for the purposes of this tutorial, we'll be using some global
57 | state to track the properties of our turtle:
58 |
59 | {[
60 | (* whether the turtle's pen is down or up *)
61 | let pen_down = ref false
62 | (* direction that the turtle is facing *)
63 | let direction = ref Up
64 | ]}
65 |
66 | Next, let's define some OCaml functions to update the state of the
67 | turtle.
68 |
69 | Because we want to call these functions from within Guile, these
70 | manipulation functions must take in and return values of type
71 | {!Guile.scm} (an abstract type that encodes Guile runtime values).
72 |
73 | As an example, here's a function [set_pen_down: Guile.scm ->
74 | Guile.scm] that, when called with a {!Guile.scm} boolean value,
75 | updates the state of the turtle's pen with the requested value:
76 |
77 | {[
78 | let set_pen_down v =
79 | if not @@ Guile.Bool.is_bool v then
80 | failwith "expected boolean argument";
81 | let v = Guile.Bool.from_raw v in
82 | pen_down := v;
83 | Guile.eol
84 | ]}
85 |
86 | The function first validates the type of its argument using the
87 | {!Guile.Bool.is_bool} helper function. If provided an incorrect type,
88 | it raises an OCaml exception (internally this will be caught and
89 | exposed to the Guile runtime as a Guile exception). After validating
90 | the type, we can then extract the concrete boolean value using
91 | [Guile.Bool.from_raw] and then use normal OCaml code to update the
92 | state of the [pen_down] variable. Finally, as Guile Scheme is an
93 | expression oriented language, our callbacks have to return a
94 | [Guile.scm] value - in this case we return the equivalent [unit] in
95 | Guile: {!Guile.eol}.
96 |
97 | To allow this function to be called from within a Guile context, we
98 | can {i expose} the function under the name [pen-down] using the
99 | functions in {!Guile.Functions} - in this case
100 | {!Guile.Functions.register_fun1}:
101 |
102 | {[
103 | let () = ignore @@ Guile.Functions.register_fun1 "pen-down" set_pen_down
104 | ]}
105 |
106 | Following this pattern, we can also define a few other helper functions to manipulate the turtle's state:
107 |
108 | Firstly, a few functions to change the direction of the turtle:
109 | {[
110 | let turn_left _ =
111 | direction := turn_left !direction;
112 | Guile.eol
113 |
114 | let turn_right _ =
115 | direction := turn_right !direction;
116 | Guile.eol
117 |
118 | let () =
119 | Guile.Functions.register_fun1 ~no_opt:1 "turn-left" turn_left;
120 | Guile.Functions.register_fun1 ~no_opt:1 "turn-right" turn_right
121 | ]}
122 |
123 | Here, as turn_left and turn_right don't require any arguments, we use
124 | the [~no_opt] parameter of {!Guile.Functions.register_fun1} to
125 | indicate that the last (and only) argument to these functions is
126 | optional.
127 |
128 | Next, we can define a function to move the turtle in the direction its facing:
129 | {[
130 | let move_by n =
131 | if not @@ Guile.Number.is_integer n then
132 | failwith "expected numeric arg";
133 | let n = Guile.Number.int_from_raw n in
134 | let x, y =
135 | let cur_pos = Graphics.current_point () in
136 | move n cur_pos !direction in
137 | if !pen_down then
138 | Graphics.lineto x y;
139 | Graphics.moveto x y;
140 | Guile.eol
141 |
142 | let () = ignore @@ Guile.Functions.register_fun1 "move-by" move_by
143 | ]}
144 |
145 | Finally, a "warping" function to quickly jump the turtle to a
146 | pre-defined location on the screen:
147 |
148 | {[
149 | let move_to x y =
150 | if (not @@ Guile.Number.is_integer x) ||
151 | (not @@ Guile.Number.is_integer y) then
152 | failwith "expected numeric position";
153 | let x, y =
154 | Guile.Number.int_from_raw x,
155 | Guile.Number.int_from_raw y in
156 | if !pen_down then
157 | Graphics.lineto x y;
158 | Graphics.moveto x y;
159 | Guile.eol
160 |
161 | let () = ignore @@ Guile.Functions.register_fun2 "move-to" move_to
162 | ]}
163 |
164 |
165 | Putting things all together, we can then complete our drawing program by simply initialising the [Graphics] context and then starting a Guile repl:
166 |
167 | {[
168 | let () =
169 | (* setup graphics context *)
170 | Graphics.open_graph " 400x400+50-0";
171 | Graphics.auto_synchronize true;
172 | Graphics.moveto 200 200;
173 | (* start guile repl *)
174 | Guile.shell ()
175 | ]}
176 |
177 | With that, we're done! Congratulations! You now have a functional
178 | Guile Scheme repl which can be used to tune and extend your drawing
179 | program!
180 |
181 | Having completed this tutorial, you should be all set to try extending
182 | your OCaml programs with Guile scheme! Please also check out the
183 | {{!Guile}API documentation} to find out more specific information on
184 | how you can use ocaml-guile for your particular use case.
185 |
--------------------------------------------------------------------------------
/dune-project:
--------------------------------------------------------------------------------
1 | (lang dune 2.9)
2 | (package
3 | (name guile)
4 | (synopsis "Bindings to GNU Guile Scheme for OCaml")
5 | (description
6 | "The guile library is Free Software high-level OCaml bindings to GNU Guile 3.0, supporting easy interop between OCaml and GNU Guile Scheme.")
7 | (depends
8 | (ocaml (>= 4.08.0))
9 | (sexplib (>= v0.12))
10 | (ctypes (>= 0.18.0))
11 | (ctypes-foreign (>= 0.18.0))
12 | (dune-configurator (>= 2.9.1))))
13 | (generate_opam_files true)
14 | (license GPL-3.0+)
15 | (source (uri git+https://github.com/gopiandcode/guile-ocaml.git))
16 | (bug_reports https://github.com/gopiandcode/guile-ocaml/issues)
17 | (homepage https://github.com/gopiandcode/guile-ocaml)
18 | (name guile)
19 | (authors "Kiran Gopinathan")
20 | (maintainers "kirang@comp.nus.edu.sg")
21 | (use_standard_c_and_cxx_flags true)
22 |
--------------------------------------------------------------------------------
/examples/hello-world/dune:
--------------------------------------------------------------------------------
1 | (executable (name hello_world)
2 | (libraries guile))
3 |
--------------------------------------------------------------------------------
/examples/hello-world/hello_world.ml:
--------------------------------------------------------------------------------
1 |
2 | let my_fun s =
3 | if not @@ Guile.String.is_string s then
4 | failwith "expected string input";
5 | let s = Guile.String.from_raw s in
6 | Format.printf "swipl -> OCaml: %s\n%!" s;
7 | Guile.String.to_raw (s ^ " world\n")
8 |
9 |
10 | let () =
11 | Guile.init ();
12 | ignore @@ Guile.Functions.register_fun1 "my-fun" my_fun;
13 |
14 | let s =
15 | Guile.eval_string {|
16 | (let ((x "hello"))
17 | (set! x (my-fun x))
18 | (display x)
19 | x)
20 | |} in
21 | let result = Guile.to_string s in
22 | Printf.printf "OCaml -> swipl: %s\n%!" @@ result
23 |
24 |
--------------------------------------------------------------------------------
/examples/interactive-shell/dune:
--------------------------------------------------------------------------------
1 | (executable (name interactive_shell)
2 | (libraries guile))
3 |
--------------------------------------------------------------------------------
/examples/interactive-shell/interactive_shell.ml:
--------------------------------------------------------------------------------
1 |
2 | let var = ref 0
3 |
4 | let incr_var v =
5 | if not Guile.(v = undefined) then
6 | failwith "expected nullary argument";
7 | incr var;
8 | Guile.eol
9 |
10 | let get_var v =
11 | if not Guile.(v = undefined) then
12 | failwith "expected nullary argument";
13 | let v = !var in
14 | Guile.Number.int_to_raw v
15 |
16 | let () =
17 | Guile.init ();
18 | ignore @@ Guile.Functions.register_fun1 "incr-var"
19 | ~no_opt:1 incr_var;
20 | ignore @@ Guile.Functions.register_fun1 "get-var"
21 | ~no_opt:1 get_var;
22 | Guile.shell ()
23 |
--------------------------------------------------------------------------------
/examples/turtle-program/dune.disabled:
--------------------------------------------------------------------------------
1 | (executable (name turtle_program)
2 | (libraries guile graphics))
3 |
--------------------------------------------------------------------------------
/examples/turtle-program/turtle_program.ml:
--------------------------------------------------------------------------------
1 | type direction = Up | Down | Left | Right
2 |
3 | let turn_right = function Up -> Left | Left -> Down | Down -> Right | Right -> Up
4 | let turn_left = function Left -> Up | Down -> Left | Right -> Down | Up -> Right
5 |
6 | let move n (x,y) = function
7 | | Up -> (x, y + n)
8 | | Down -> (x, y - n)
9 | | Left -> (x - n, y)
10 | | Right -> (x + n, y)
11 |
12 | let pen_down = ref false
13 | let direction = ref Up
14 |
15 | let set_pen_down v =
16 | if not @@ Guile.Bool.is_bool v then
17 | failwith "expected boolean argument";
18 | let v = Guile.Bool.from_raw v in
19 | pen_down := v;
20 | Guile.eol
21 |
22 | let turn_left _ =
23 | direction := turn_left !direction;
24 | Guile.eol
25 |
26 | let turn_right _ =
27 | direction := turn_right !direction;
28 | Guile.eol
29 |
30 | let move_by n =
31 | if not @@ Guile.Number.is_integer n then
32 | failwith "expected numeric arg";
33 | let n = Guile.Number.int_from_raw n in
34 | let x, y =
35 | let cur_pos = Graphics.current_point () in
36 | move n cur_pos !direction in
37 | if !pen_down then
38 | Graphics.lineto x y;
39 | Graphics.moveto x y;
40 | Guile.eol
41 |
42 | let move_to x y =
43 | if (not @@ Guile.Number.is_integer x) ||
44 | (not @@ Guile.Number.is_integer y) then
45 | failwith "expected numeric position";
46 | let x, y =
47 | Guile.Number.int_from_raw x,
48 | Guile.Number.int_from_raw y in
49 | if !pen_down then
50 | Graphics.lineto x y;
51 | Graphics.moveto x y;
52 | Guile.eol
53 |
54 | let () =
55 | Graphics.open_graph " 400x400+50-0";
56 | Graphics.auto_synchronize true;
57 | Graphics.moveto 200 200;
58 | Guile.init ();
59 | ignore @@ Guile.Functions.register_fun1 "pen-down" set_pen_down;
60 | ignore @@ Guile.Functions.register_fun1 ~no_opt:1 "turn-left" turn_left;
61 | ignore @@ Guile.Functions.register_fun1 ~no_opt:1 "turn-right" turn_right;
62 | ignore @@ Guile.Functions.register_fun1 "move-by" move_by;
63 | ignore @@ Guile.Functions.register_fun2 "move-to" move_to;
64 | Guile.shell ()
65 |
66 |
--------------------------------------------------------------------------------
/guile.opam:
--------------------------------------------------------------------------------
1 | # This file is generated by dune, edit dune-project instead
2 | opam-version: "2.0"
3 | version: "1.0"
4 | synopsis: "Bindings to GNU Guile Scheme for OCaml"
5 | description:
6 | "The guile library is Free Software high-level OCaml bindings to GNU Guile 3.0, supporting easy interop between OCaml and GNU Guile Scheme."
7 | maintainer: ["kirang@comp.nus.edu.sg"]
8 | authors: ["Kiran Gopinathan"]
9 | license: "GPL-3.0+"
10 | homepage: "https://github.com/gopiandcode/guile-ocaml"
11 | bug-reports: "https://github.com/gopiandcode/guile-ocaml/issues"
12 | depends: [
13 | "dune" {>= "2.9"}
14 | "ocaml" {>= "4.08.0"}
15 | "sexplib" {>= "v0.12"}
16 | "ctypes" {>= "0.18.0"}
17 | "ctypes-foreign" {>= "0.18.0"}
18 | "dune-configurator" {>= "2.9.1"}
19 | "odoc" {with-doc}
20 | ]
21 | build: [
22 | ["dune" "subst"] {dev}
23 | [
24 | "dune"
25 | "build"
26 | "-p"
27 | name
28 | "-j"
29 | jobs
30 | "--promote-install-files=false"
31 | "@install"
32 | "@runtest" {with-test}
33 | "@doc" {with-doc}
34 | ]
35 | ["dune" "install" "-p" name "--create-install-files" name]
36 | ]
37 | dev-repo: "git+https://github.com/gopiandcode/guile-ocaml.git"
38 |
--------------------------------------------------------------------------------
/lib/dune:
--------------------------------------------------------------------------------
1 | (library
2 | (name guile)
3 | (public_name guile.guile)
4 | (libraries ctypes ctypes.foreign str bindings sexplib)
5 | (c_library_flags (:include c_library_flags.sexp))
6 | (ocamlopt_flags (-ccopt (:include ccopts.sexp)))
7 | (foreign_stubs
8 | (language c)
9 | (names guile_stubs)
10 | (flags (:include c_flags.sexp))
11 | )
12 | )
13 |
14 |
15 | (rule
16 | (targets c_flags.sexp c_library_flags.sexp ccopts.sexp)
17 | (deps (:x ../config/discover.exe))
18 | (action (run %{x})))
19 |
20 | (rule
21 | (targets bindings_stubs.ml)
22 | (deps ../stubgen/bindings_stubs_gen.exe)
23 | (action (with-stdout-to %{targets} (run %{deps} -ml))))
24 |
25 | (env
26 | (dev
27 | (flags (:standard -w -27 -w -9))))
28 |
--------------------------------------------------------------------------------
/lib/guile.ml:
--------------------------------------------------------------------------------
1 | (*
2 | GNU Guile OCaml Bindings
3 |
4 | Copyright (C) 2021 Kiran Gopinathan
5 |
6 | This program is free software: you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation, either version 3 of the License, or
9 | (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with this program. If not, see .
18 | *)
19 |
20 | type scm = Raw.scm
21 |
22 | let init_with f =
23 | ignore @@ Raw.scm_with_guile (fun v -> f (); v) Ctypes.null
24 |
25 | let with_continuation_barrier f =
26 | ignore @@ Raw.scm_with_continuation_barrier (fun v -> f (); v) Ctypes.null
27 |
28 | let init () =
29 | Raw.scm_init_guile ()
30 |
31 | let shell () =
32 | Raw.scm_shell Sys.argv
33 |
34 | let load filename = Raw.scm_primitive_load filename
35 |
36 | let eol: scm = Ctypes.ptr_of_raw_address (Ctypes.Intptr.to_nativeint Raw.Bindings.scm_eol)
37 | let undefined: scm = Ctypes.ptr_of_raw_address (Ctypes.Intptr.to_nativeint Raw.Bindings.scm_undefined)
38 |
39 | let (=) l r = Raw.scm_is_eq l r
40 |
41 | module Bool = struct
42 |
43 | let t: scm = Ctypes.ptr_of_raw_address (Ctypes.Intptr.to_nativeint Raw.Bindings.scml_bool_t)
44 | let f: scm = Ctypes.ptr_of_raw_address (Ctypes.Intptr.to_nativeint Raw.Bindings.scml_bool_f)
45 |
46 | let boolean_p v = Raw.scm_boolean_p v
47 | let is_bool v = Raw.scm_is_bool v
48 |
49 | let not v = Raw.scm_not v
50 |
51 | let to_raw v = Raw.scm_from_bool v
52 | let from_raw v = Raw.scm_to_bool v
53 |
54 | end
55 |
56 | module Number = struct
57 | let number_p v = Raw.scm_number_p v
58 | let is_number v = Raw.scm_is_number v
59 |
60 | let integer_p v = Raw.scm_integer_p v
61 | let is_integer v = Raw.scm_is_integer v
62 |
63 | let exact_integer_p v = Raw.scm_exact_integer_p v
64 | let is_exact_integer v = Raw.scm_is_exact_integer v
65 |
66 | let char_from_raw v = Raw.scm_to_char v
67 | let schar_from_raw v = Raw.scm_to_schar v
68 | let uchar_from_raw v = Raw.scm_to_uchar v
69 | let short_from_raw v = Raw.scm_to_short v
70 | let ushort_from_raw v = Raw.scm_to_ushort v
71 | let int_from_raw v = Raw.scm_to_int v
72 | let uint_from_raw v = Raw.scm_to_uint v
73 | let long_from_raw v = Raw.scm_to_long v
74 | let ulong_from_raw v = Raw.scm_to_ulong v
75 | let long_long_from_raw v = Raw.scm_to_long_long v
76 | let ulong_long_from_raw v = Raw.scm_to_ulong_long v
77 | let size_t_from_raw v = Raw.scm_to_size_t v
78 |
79 | let char_to_raw v = Raw.scm_from_char v
80 | let schar_to_raw v = Raw.scm_from_schar v
81 | let uchar_to_raw v = Raw.scm_from_uchar v
82 | let short_to_raw v = Raw.scm_from_short v
83 | let ushort_to_raw v = Raw.scm_from_ushort v
84 | let int_to_raw v = Raw.scm_from_int v
85 | let uint_to_raw v = Raw.scm_from_uint v
86 | let long_to_raw v = Raw.scm_from_long v
87 | let ulong_to_raw v = Raw.scm_from_ulong v
88 | let long_long_to_raw v = Raw.scm_from_long_long v
89 | let ulong_long_to_raw v = Raw.scm_from_ulong_long v
90 | let size_t_to_raw v = Raw.scm_from_size_t v
91 | module Float = struct
92 |
93 | let real_p v = Raw.scm_real_p v
94 |
95 | let is_real v = Raw.scm_is_real v
96 |
97 | let rationalp v = Raw.scm_rational_p v
98 | let is_rational v = Raw.scm_is_rational v
99 |
100 | let rationalize v = Raw.scm_rationalize v
101 |
102 | let inf_p v = Raw.scm_inf_p v
103 | let nan_p v = Raw.scm_nan_p v
104 |
105 | let finite_p v = Raw.scm_finite_p v
106 |
107 | let nan v = Raw.scm_nan v
108 | let inf v = Raw.scm_inf v
109 |
110 | let numerator v = Raw.scm_numerator v
111 | let denominator v = Raw.scm_denominator v
112 |
113 | let from_raw v = Raw.scm_to_double v
114 | let to_raw v = Raw.scm_from_double v
115 |
116 | end
117 |
118 | module Complex = struct
119 |
120 | let complex_p v = Raw.scm_complex_p v
121 |
122 | let is_complex v = Raw.scm_is_complex v
123 |
124 | end
125 |
126 | let exact_p v = Raw.scm_exact_p v
127 | let is_exact v = Raw.scm_is_exact v
128 |
129 | let inexact_p v = Raw.scm_inexact_p v
130 | let is_inexact v = Raw.scm_is_inexact v
131 |
132 | let inexact_to_exact v = Raw.scm_inexact_to_exact v
133 | let exact_to_inexact v = Raw.scm_exact_to_inexact v
134 |
135 | end
136 |
137 | module Pair = struct
138 |
139 | let cons hd tl = Raw.scm_cons hd tl
140 |
141 | let car pair = Raw.scm_car pair
142 | let cdr pair = Raw.scm_cdr pair
143 |
144 | let caar pair = Raw.scm_caar pair
145 | let cadr pair = Raw.scm_cadr pair
146 | let cdar pair = Raw.scm_cdar pair
147 |
148 | let hd pair = car pair
149 | let tl pair = cdr pair
150 |
151 | let set_car pair vl = Raw.scm_setcar pair vl
152 | let set_cdr pair vl = Raw.scm_setcdr pair vl
153 |
154 |
155 | let is_cons x = Raw.scm_is_pair x
156 |
157 | let is_ncons x = not (is_cons x)
158 |
159 | end
160 |
161 | module List = struct
162 |
163 | let is_null = Raw.scm_is_null
164 |
165 | let of_raw f scm =
166 | let rec of_list acc f scm =
167 | if is_null scm
168 | then List.rev acc
169 | else begin
170 | if not @@ Pair.is_cons scm then
171 | failwith "found non-list construction";
172 | let hd = Pair.car scm in
173 | let tl = Pair.cdr scm in
174 | of_list (f hd :: acc) f tl
175 | end in
176 | of_list [] f scm
177 |
178 | let rec to_raw f = function
179 | | [] -> eol
180 | | [x] -> Raw.scm_list_1 (f x)
181 | | [x1;x2] -> Raw.scm_list_2 (f x1) (f x2)
182 | | [x1;x2;x3] -> Raw.scm_list_3 (f x1) (f x2) (f x3)
183 | | [x1;x2;x3;x4] -> Raw.scm_list_4 (f x1) (f x2) (f x3) (f x4)
184 | | [x1;x2;x3;x4;x5] -> Raw.scm_list_5 (f x1) (f x2) (f x3) (f x4) (f x5)
185 | | hd :: tl -> Raw.scm_cons (f hd) (to_raw f tl)
186 |
187 | end
188 |
189 | module Char = struct
190 |
191 | let char_p v = Raw.scm_char_p v
192 |
193 | let is_char v = char_p v |> Bool.from_raw
194 |
195 | let alphabetic_p v = Raw.scm_char_alphabetic_p v
196 | let is_alphabetic v = alphabetic_p v |> Bool.from_raw
197 |
198 | let numeric_p v = Raw.scm_char_numeric_p v
199 | let is_numeric v = numeric_p v |> Bool.from_raw
200 |
201 | let whitespace_p v = Raw.scm_char_whitespace_p v
202 | let is_whitespace v = whitespace_p v |> Bool.from_raw
203 |
204 | let upper_case_p v = Raw.scm_char_upper_case_p v
205 | let is_upper_case v = upper_case_p v |> Bool.from_raw
206 |
207 | let lower_case_p v = Raw.scm_char_lower_case_p v
208 | let is_lower_case v = lower_case_p v |> Bool.from_raw
209 |
210 | let is_both_p v = Raw.scm_char_is_both_p v
211 | let is_both v = is_both_p v |> Bool.from_raw
212 |
213 | let general_category_p v = Raw.scm_char_general_category v
214 | let is_general_category v = general_category_p v |> Bool.from_raw
215 |
216 | let from_raw = Number.char_from_raw
217 | let to_raw = Number.char_to_raw
218 |
219 | end
220 |
221 | module String = struct
222 |
223 | let string_p v = Raw.scm_string_p v
224 | let is_string v = Raw.scm_is_string v
225 | let is_empty v = Raw.scm_string_null_p v
226 |
227 | let string ls = Raw.scm_string (List.to_raw Char.to_raw ls)
228 |
229 | let len s = Raw.scm_string_length s |> Number.int_from_raw
230 |
231 | let to_raw s = Raw.scm_from_locale_string s
232 | let from_raw s =
233 | let len = (len s) in
234 | let buf = Ctypes.CArray.make Ctypes.char len in
235 | let _ = Raw.scm_to_locale_stringbuf s (Ctypes.CArray.start buf) (Unsigned.Size_t.of_int len) in
236 | Ctypes.string_from_ptr (Ctypes.CArray.start buf) ~length:len
237 |
238 | end
239 |
240 | module Symbol = struct
241 |
242 | let symbol_p v = Raw.scm_symbol_p v
243 | let is_symbol v = symbol_p v |> Bool.from_raw
244 |
245 | let to_raw s = Raw.scm_string_from_utf8_symbol s
246 | let from_raw s = Raw.scm_symbol_to_string s |> String.from_raw
247 |
248 | let gensym s = Raw.scm_gensym (to_raw s)
249 |
250 | end
251 |
252 | module Error = struct
253 |
254 | let error ?key ?fn_name message =
255 | let key = match key with None -> Symbol.to_raw "ocaml-guile" | Some key -> key in
256 | Raw.scm_error key fn_name (Some message) eol Bool.f
257 |
258 | let catch ~tag f on_catch =
259 | ignore @@ Raw.scm_c_catch
260 | tag (fun null -> f (); null) Ctypes.null
261 | (fun null key args -> on_catch key args; null) Ctypes.null
262 |
263 | end
264 |
265 | module Functions = struct
266 |
267 | let safe_fun1 name f v =
268 | try f v with e -> Error.error ~fn_name:name (Printexc.to_string e)
269 | let safe_fun2 name f v1 v2 =
270 | try f v1 v2 with e -> Error.error ~fn_name:name (Printexc.to_string e)
271 | let safe_fun3 name f v1 v2 v3 =
272 | try f v1 v2 v3 with e -> Error.error ~fn_name:name (Printexc.to_string e)
273 | let safe_fun4 name f v1 v2 v3 v4 =
274 | try f v1 v2 v3 v4 with e -> Error.error ~fn_name:name (Printexc.to_string e)
275 | let safe_fun5 name f v1 v2 v3 v4 v5 =
276 | try f v1 v2 v3 v4 v5 with e -> Error.error ~fn_name:name (Printexc.to_string e)
277 | let safe_fun6 name f v1 v2 v3 v4 v5 v6 =
278 | try f v1 v2 v3 v4 v5 v6 with e -> Error.error ~fn_name:name (Printexc.to_string e)
279 | let safe_fun7 name f v1 v2 v3 v4 v5 v6 v7 =
280 | try f v1 v2 v3 v4 v5 v6 v7 with e -> Error.error ~fn_name:name (Printexc.to_string e)
281 | let safe_fun8 name f v1 v2 v3 v4 v5 v6 v7 v8 =
282 | try f v1 v2 v3 v4 v5 v6 v7 v8 with e -> Error.error ~fn_name:name (Printexc.to_string e)
283 | let safe_fun9 name f v1 v2 v3 v4 v5 v6 v7 v8 v9 =
284 | try f v1 v2 v3 v4 v5 v6 v7 v8 v9 with e -> Error.error ~fn_name:name (Printexc.to_string e)
285 | let safe_fun10 name f v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 =
286 | try f v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 with e -> Error.error ~fn_name:name (Printexc.to_string e)
287 |
288 | let register_fun1 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm) -> scm =
289 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_1 fname ?no_opt ?rst (safe_fun1 fname f)
290 | let register_fun2 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm) -> scm =
291 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_2 fname ?no_opt ?rst (safe_fun2 fname f)
292 | let register_fun3 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm) -> scm =
293 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_3 fname ?no_opt ?rst (safe_fun3 fname f)
294 | let register_fun4 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm -> scm) -> scm =
295 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_4 fname ?no_opt ?rst (safe_fun4 fname f)
296 | let register_fun5 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm -> scm -> scm) -> scm =
297 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_5 fname ?no_opt ?rst (safe_fun5 fname f)
298 | let register_fun6 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm =
299 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_6 fname ?no_opt ?rst (safe_fun6 fname f)
300 | let register_fun7 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm =
301 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_7 fname ?no_opt ?rst (safe_fun7 fname f)
302 | let register_fun8 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm =
303 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_8 fname ?no_opt ?rst (safe_fun8 fname f)
304 | let register_fun9 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm =
305 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_9 fname ?no_opt ?rst (safe_fun9 fname f)
306 | let register_fun10 : string -> ?no_opt:int -> ?rst: bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm =
307 | fun fname ?no_opt ?rst f -> Raw.scm_define_gsubr_10 fname ?no_opt ?rst (safe_fun10 fname f)
308 |
309 | end
310 |
311 | let eval ?state s =
312 | let state = match state with Some state -> state | None -> Raw.scm_interaction_environment () in
313 | Raw.scm_eval s state
314 |
315 | let eval_string s = Raw.scm_eval_string (String.to_raw s)
316 |
317 | let to_string ?printer v =
318 | let printer = Option.value ~default:undefined printer in
319 | Raw.scm_object_to_string v printer
320 | |> String.from_raw
321 |
322 | module Sexp = struct
323 |
324 | let rec to_raw : Sexplib.Sexp.t -> scm =
325 | function
326 | | Atom a when Stdlib.(String.get a 0 = '"') ->
327 | String.to_raw Stdlib.(String.sub a 1 (String.length a - 2))
328 | | Atom a ->
329 | begin match int_of_string_opt a with
330 | | Some n -> Number.int_to_raw n
331 | | None -> match float_of_string_opt a with
332 | Some f -> Number.Float.to_raw f
333 | | None -> Symbol.to_raw a
334 | end
335 | | List elts ->
336 | List.to_raw to_raw elts
337 |
338 | let rec from_raw : scm -> Sexplib.Sexp.t = fun s ->
339 | if Pair.is_cons s
340 | then loop [] s
341 | else Sexplib.Sexp.Atom (to_string s)
342 | and loop acc s =
343 | if Pair.is_cons s
344 | then
345 | let hd = Pair.hd s in
346 | let tl = Pair.tl s in
347 | loop (from_raw hd :: acc) tl
348 | else if List.is_null s
349 | then Sexplib.Sexp.List (Stdlib.List.rev acc)
350 | else Sexplib.Sexp.List (Stdlib.List.rev (from_raw s :: acc))
351 |
352 | end
353 |
354 | module Module = struct
355 |
356 | let resolve v = Raw.scm_resolve_module v
357 |
358 | let with_current_module ~modl f =
359 | ignore @@ Raw.scm_call_with_current_module modl (fun null -> f (); null) Ctypes.null
360 |
361 | let lookup_variable ~modl name = Raw.scm_variable modl name
362 |
363 | let lookup ~modl name = Raw.scm_variable_ref modl name
364 |
365 | let is_defined ?modl name =
366 | let modl = Option.value modl ~default:undefined in
367 | Raw.scm_defined_p (Symbol.to_raw name) modl |> Bool.from_raw
368 |
369 | let define_module name f = Raw.scm_define_module name (fun null -> f (); null) Ctypes.null
370 |
371 | let define name vl = Raw.scm_define name vl
372 |
373 | let use v = Raw.scm_use_module v
374 |
375 | let export name = Raw.scm_export name Ctypes.null
376 |
377 | end
378 |
--------------------------------------------------------------------------------
/lib/guile.mli:
--------------------------------------------------------------------------------
1 | (*
2 | GNU Guile OCaml Bindings
3 |
4 | Copyright (C) 2021 Kiran Gopinathan
5 |
6 | This program is free software: you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation, either version 3 of the License, or
9 | (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with this program. If not, see .
18 | *)
19 |
20 | type scm
21 | (** opaque type representing Guile scheme values. *)
22 |
23 | val init_with : (unit -> unit) -> unit
24 | (** [init_with f] calls [f] within a fresh Guile context. *)
25 |
26 | val with_continuation_barrier : (unit -> unit) -> unit
27 | (** [with_continuation_barrier f] runs the function [f] preventing any
28 | non-local control flow beyond the current calling context. *)
29 |
30 | val init : unit -> unit
31 | (** [init ()] initialises the Guile context for the current thread of
32 | execution. *)
33 |
34 | val shell : unit -> unit
35 | (** [shell ()] starts execution of a Guile repl.
36 |
37 | Note: assumes [Guile.init] has been called. *)
38 |
39 | val load: string -> scm
40 | (** [load filename] loads the file at [filename] and evaluates it as a Guile scheme object. *)
41 |
42 | val eol : scm
43 | (** [eol] represents an empty list in Guile. *)
44 |
45 | val undefined : scm
46 | (** [undefined] represents a nullary value in Guile, can be passed in as none values to functions with optional arguments. *)
47 |
48 | val ( = ) : scm -> scm -> bool
49 | (** [(=) x y] tests for equality between two Guile entities. *)
50 |
51 | module Bool : sig
52 |
53 | val t : scm
54 | (** [t] is the Guile value encoding true. *)
55 |
56 | val f : scm
57 | (** [t] is the Guile value encoding false. *)
58 |
59 | val boolean_p : scm -> scm
60 | (** [boolean_p b] returns #t if [b] is a boolean and #f otherwise. *)
61 |
62 | val is_bool : scm -> bool
63 | (** [is_bool b] returns true if [b] is a boolean and false otherwise. *)
64 |
65 | val not : scm -> scm
66 | (** [not b] negates the boolean [b]. *)
67 |
68 | val to_raw : bool -> scm
69 | (** [to_raw b] converts the OCaml boolean [b] to a Guile boolean. *)
70 |
71 | val from_raw : scm -> bool
72 | (** [from_raw b] converts the Guile boolean [b] to an OCaml boolean. *)
73 |
74 | end
75 |
76 | module Number : sig
77 |
78 | val number_p : scm -> scm
79 | (** [number_p v] returns #t if [v] is a number and #f otherwise. *)
80 |
81 | val is_number : scm -> bool
82 | (** [is_number v] returns true if [v] is a number and false otherwise. *)
83 |
84 | val integer_p : scm -> scm
85 | (** [integer_p v] returns #t if [v] is an integer and #f otherwise. *)
86 |
87 | val is_integer : scm -> bool
88 | (** [is_integer v] returns true if [v] is an integer and false otherwise. *)
89 |
90 | val exact_integer_p : scm -> scm
91 | (** [exact_integer_p v] returns #t if [v] is an exact integer and #f otherwise. *)
92 |
93 | val is_exact_integer : scm -> bool
94 | (** [is_exact_integer v] returns true if [v] is an exact integer and false otherwise. *)
95 |
96 | val char_from_raw : scm -> char
97 | (** [char_from_raw v] extracts an OCaml char from a Guile value [v]. *)
98 |
99 | val schar_from_raw : scm -> int
100 | (** [schar_from_raw v] extracts an OCaml signed char from a Guile value [v]. *)
101 |
102 | val uchar_from_raw : scm -> Unsigned.uchar
103 | (** [uchar_from_raw v] extracts an OCaml unsigned char from a Guile value [v]. *)
104 |
105 | val short_from_raw : scm -> int
106 | (** [short_from_raw v] extracts an OCaml short from a Guile value [v]. *)
107 |
108 | val ushort_from_raw : scm -> Unsigned.ushort
109 | (** [ushort_from_raw v] extracts an OCaml unsigned short from a Guile value [v]. *)
110 |
111 | val int_from_raw : scm -> int
112 | (** [int_from_raw v] extracts an OCaml int from a Guile value [v]. *)
113 |
114 | val uint_from_raw : scm -> Unsigned.uint
115 | (** [uint_from_raw v] extracts an OCaml unsigned int from a Guile value [v]. *)
116 |
117 | val long_from_raw : scm -> Signed.long
118 | (** [long_from_raw v] extracts an OCaml long from a Guile value [v]. *)
119 |
120 | val ulong_from_raw : scm -> Unsigned.ulong
121 | (** [long_from_raw v] extracts an OCaml unsigned long from a Guile value [v]. *)
122 |
123 | val long_long_from_raw : scm -> Signed.llong
124 | (** [long_long_from_raw v] extracts an OCaml long long from a Guile value [v]. *)
125 |
126 | val ulong_long_from_raw : scm -> Unsigned.ullong
127 | (** [ulong_long_from_raw v] extracts an OCaml unsigned long long from a Guile value [v]. *)
128 |
129 | val size_t_from_raw : scm -> Unsigned.size_t
130 | (** [size_t_from_raw v] extracts an OCaml size_t from a Guile value [v]. *)
131 |
132 | val char_to_raw : char -> scm
133 | (** [char_to_raw c] converts an OCaml char [c] into a Guile value. *)
134 |
135 | val schar_to_raw : int -> scm
136 | (** [schar_to_raw c] converts an OCaml signed char [c] into a Guile value. *)
137 |
138 | val uchar_to_raw : Unsigned.uchar -> scm
139 | (** [uchar_to_raw c] converts an OCaml unsigned char [c] into a Guile value. *)
140 |
141 | val short_to_raw : int -> scm
142 | (** [short_to_raw c] converts an OCaml short [c] into a Guile value. *)
143 |
144 | val ushort_to_raw : Unsigned.ushort -> scm
145 | (** [ushort_to_raw c] converts an OCaml unsigned short [c] into a Guile value. *)
146 |
147 | val int_to_raw : int -> scm
148 | (** [int_to_raw i] converts an OCaml int [i] into a Guile value. *)
149 |
150 | val uint_to_raw : Unsigned.uint -> scm
151 | (** [uint_to_raw i] converts an OCaml unsigned int [i] into a Guile value. *)
152 |
153 | val long_to_raw : Signed.long -> scm
154 | (** [long_to_raw l] converts an OCaml long [l] into a Guile value. *)
155 |
156 | val ulong_to_raw : Unsigned.ulong -> scm
157 | (** [ulong_to_raw l] converts an OCaml unsigned long [l] into a Guile value. *)
158 |
159 | val long_long_to_raw : Signed.llong -> scm
160 | (** [long_long_to_raw l] converts an OCaml long long [l] into a Guile value. *)
161 |
162 | val ulong_long_to_raw : Unsigned.ullong -> scm
163 | (** [ulong_long_to_raw l] converts an OCaml unsigned long long [l] into a Guile value. *)
164 |
165 | val size_t_to_raw : Unsigned.size_t -> scm
166 | (** [size_t_to_raw l] converts an OCaml size_t [l] into a Guile value. *)
167 |
168 | module Float : sig
169 |
170 | val real_p : scm -> scm
171 | (** [real_p v] returns #t if [v] is a real value and #f otherwise. *)
172 |
173 | val is_real : scm -> bool
174 | (** [is_real v] returns true if [v] is a real value and false otherwise. *)
175 |
176 | val rationalp : scm -> scm
177 | (** [rational_p v] returns #t if [v] is a rational value and #f otherwise. *)
178 |
179 | val is_rational : scm -> bool
180 | (** [is_rational v] returns true if [v] is a rational value and false otherwise. *)
181 |
182 | val rationalize : scm -> scm -> scm
183 |
184 | val inf_p : scm -> scm
185 | (** [inf_p v] returns #t if [v] is a inf value and #f otherwise. *)
186 |
187 | val nan_p : scm -> scm
188 | (** [nan_p v] returns #t if [v] is a nan value and #f otherwise. *)
189 |
190 | val finite_p : scm -> scm
191 | (** [finite_p v] returns #t if [v] is a finite value and #f otherwise. *)
192 |
193 | val nan : unit -> scm
194 | (** [nan ()] returns the Guile value representing nan. *)
195 |
196 | val inf : unit -> scm
197 | (** [inf ()] returns the Guile value representing inf. *)
198 |
199 | val numerator : scm -> scm
200 | (** [numerator v] returns the numerator of a rational value [v]. *)
201 |
202 | val denominator : scm -> scm
203 | (** [denominator v] returns the denominator of a rational value [v]. *)
204 |
205 | val from_raw : scm -> float
206 | (** [from_raw v] extracts an OCaml float from a Guile value [v]. *)
207 |
208 | val to_raw : float -> scm
209 | (** [to_raw f] converts an OCaml float [f] into a Guile value. *)
210 |
211 | end
212 |
213 | module Complex : sig
214 |
215 | val complex_p : scm -> scm
216 | (** [complex_p v] returns #t if [v] is a complex number and #f otherwise. *)
217 |
218 | val is_complex : scm -> bool
219 | (** [is_complex v] returns true if [v] is a complex number and false otherwise. *)
220 |
221 | end
222 |
223 | val exact_p : scm -> scm
224 | (** [exact_p v] returns #t if [v] is an exact number and #f otherwise. *)
225 |
226 | val is_exact : scm -> bool
227 | (** [is_exact v] returns true if [v] is an exact number and false otherwise. *)
228 |
229 | val inexact_p : scm -> scm
230 | (** [inexact_p v] returns #t if [v] is an exact number and #f otherwise. *)
231 |
232 | val is_inexact : scm -> bool
233 | (** [is_inexact v] returns true if [v] is an exact number and false otherwise. *)
234 |
235 | val inexact_to_exact : scm -> scm
236 | (** [inexact_to_exact v] converts an inexact value [v] to its nearest exact counterpart. *)
237 |
238 | val exact_to_inexact : scm -> scm
239 | (** [exact_to_inexact v] converts an exact value [v] to an inexact representation. *)
240 |
241 | end
242 |
243 | module Pair : sig
244 |
245 | val cons : scm -> scm -> scm
246 | (** [cons hd tl] returns a cons cell with head [hd] and tail [tl]. *)
247 |
248 | val car : scm -> scm
249 | (** [car cell] returns the head of the cons cell [cell]. *)
250 |
251 | val cdr : scm -> scm
252 | (** [cdr cell] returns the tail of the cons cell [cell]. *)
253 |
254 | val caar : scm -> scm
255 |
256 | val cadr : scm -> scm
257 |
258 | val cdar : scm -> scm
259 |
260 | val hd : scm -> scm
261 | (** [hd cell] returns the head of the cons cell [cell]. *)
262 |
263 | val tl : scm -> scm
264 | (** [tl cell] returns the tail of the cons cell [cell]. *)
265 |
266 | val set_car : scm -> scm -> unit
267 | (** [set_car cell vl] updates the car of cell [cell] with value [vl]. *)
268 |
269 | val set_cdr : scm -> scm -> unit
270 | (** [set_cdr cell vl] updates the cdr of cell [cell] with value [vl]. *)
271 |
272 | val is_cons : scm -> bool
273 | (** [is_cons cell] returns true if [cell] is a cons cell and facelle otherwise. *)
274 |
275 | val is_ncons : scm -> bool
276 | (** [is_cons cell] returns false if [cell] is a cons cell and true otherwise. *)
277 |
278 | end
279 |
280 | module List : sig
281 |
282 | val is_null : scm -> bool
283 | (** [is_null ls] returns true if [ls] is an empty list. *)
284 |
285 | val of_raw : (scm -> 'a) -> scm -> 'a list
286 | (** [of_raw f ls] extracts a list from a Guile list [ls] using [f] to extract individual elements. *)
287 |
288 | val to_raw : ('a -> scm) -> 'a list -> scm
289 | (** [to_raw f ls] converts an OCaml list [ls] to a Guile list using [f] to encode individual elements. *)
290 |
291 | end
292 |
293 | module Char : sig
294 |
295 | val char_p : scm -> scm
296 | (** [char_p v] returns #t if [v] is a char and #f otherwise. *)
297 |
298 | val is_char : scm -> bool
299 | (** [is_char v] returns true if [v] is a char and false otherwise. *)
300 |
301 | val alphabetic_p : scm -> scm
302 | (** [alphabetic_p v] returns #t if [v] is a char and #f otherwise. *)
303 |
304 | val is_alphabetic : scm -> bool
305 | (** [is_alphabetic v] returns true if [v] is a char and false otherwise. *)
306 |
307 | val numeric_p : scm -> scm
308 | (** [numeric_p v] returns #t if [v] is a number and #f otherwise. *)
309 |
310 | val is_numeric : scm -> bool
311 | (** [is_numeric v] returns true if [v] is a number and false otherwise. *)
312 |
313 | val whitespace_p : scm -> scm
314 | (** [whitespace_p v] returns #t if [v] is whitespace and #f otherwise. *)
315 |
316 | val is_whitespace : scm -> bool
317 | (** [is_whitespace v] returns true if [v] is whitespace and false otherwise. *)
318 |
319 | val upper_case_p : scm -> scm
320 | (** [upper_case_p v] returns #t if [v] is upper case and #f otherwise. *)
321 |
322 | val is_upper_case : scm -> bool
323 | (** [is_upper_case v] returns true if [v] is upper case and false otherwise. *)
324 |
325 | val lower_case_p : scm -> scm
326 | (** [lower_case_p v] returns #t if [v] is lower case and #f otherwise. *)
327 |
328 | val is_lower_case : scm -> bool
329 | (** [is_lower_case v] returns true if [v] is lower case and false otherwise. *)
330 |
331 | val is_both_p : scm -> scm
332 | (** [is_both_p v] returns #t if [v] is either lower or upper case and #f otherwise. *)
333 |
334 | val is_both : scm -> bool
335 | (** [is_both v] returns true if [v] is either lower or upper case and false otherwise. *)
336 |
337 | val general_category_p : scm -> scm
338 | (** [general_category_p v] returns #t if [v] is a general category unicode char and #f otherwise. *)
339 |
340 | val is_general_category : scm -> bool
341 | (** [is_general_category v] returns true if [v] is a general category unicode char and false otherwise. *)
342 |
343 | val from_raw : scm -> char
344 | (** [from_raw c] converts a Guile scheme char [c] to an OCaml char. *)
345 |
346 | val to_raw : char -> scm
347 | (** [to_raw c] converts an OCaml char [c] to an Guile char. *)
348 |
349 | end
350 |
351 | module String : sig
352 |
353 | val string_p : scm -> scm
354 | (** [string_p v] returns #t if [v] is a string and #f otherwise. *)
355 |
356 | val is_string : scm -> bool
357 | (** [is_string v] returns true if [v] is a string and false otherwise. *)
358 |
359 | val is_empty : scm -> scm
360 | (** [is_empty v] returns true if [v] is an empty string and false otherwise. *)
361 |
362 | val string : char list -> scm
363 | (** [string cs] constructs a fresh Guile string from the list of characters [cs]. *)
364 |
365 | val len : scm -> int
366 | (** [len s] returns the length of the Guile string [s]. *)
367 |
368 | val to_raw : string -> scm
369 | (** [to_raw s] encodes an OCaml string [s] as a Guile string. *)
370 |
371 | val from_raw : scm -> string
372 | (** [from_raw s] extracts an OCaml string from a Guile string [s]. *)
373 |
374 | end
375 |
376 | module Symbol : sig
377 |
378 | val symbol_p : scm -> scm
379 | (** [symbol_p v] returns #t if [v] is a symbol and #f otherwise. *)
380 |
381 | val is_symbol : scm -> bool
382 | (** [is_symbol v] returns true if [v] is a symbol and false otherwise. *)
383 |
384 | val to_raw : string -> scm
385 | (** [to_raw s] converts a string [s] into a Guile symbol. *)
386 |
387 | val from_raw : scm -> string
388 | (** [from_raw s] converts a Guile symbol [s] to an OCaml string. *)
389 |
390 | val gensym : string -> scm
391 | (** [gensym s] constructs a fresh symbol based on string [s]. *)
392 |
393 | end
394 |
395 | module Error : sig
396 |
397 | val error : ?key:scm -> ?fn_name:string -> string -> scm
398 | (** [error ?key ?fn_name msg] throws a Guile scheme error with tag
399 | [key] (defaults to the symbol ocaml-guile) with message [msg],
400 | originating while executing [fn_name].
401 |
402 | Returns a dummy Guile scheme value as it does not return. *)
403 |
404 | val catch : tag:scm -> (unit -> unit) -> (scm -> scm -> unit) -> unit
405 | (** [catch ~tag f handler] runs [f] while catching any exceptions of
406 | with tag [tag]. If an exception is caught, the handler [handler]
407 | is called as [handler key args]. *)
408 |
409 | end
410 |
411 | module Functions : sig
412 |
413 | val register_fun1 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm) -> scm
414 | (** [register_fun1 fname ?no_opt ?rst f] exposes the OCaml function
415 | [f] to the Guile scheme context, under the name [fname].
416 |
417 | [no_opt] encodes the number of trailing arguments that are
418 | optional, and [rst] encodes whether the last argument should
419 | capture all extraneous arguments. *)
420 |
421 | val register_fun2 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm) -> scm
422 | (** [register_fun2 fname ?no_opt ?rst f] exposes the OCaml function
423 | [f] to the Guile scheme context, under the name [fname].
424 |
425 | [no_opt] encodes the number of trailing arguments that are
426 | optional, and [rst] encodes whether the last argument should
427 | capture all extraneous arguments. *)
428 |
429 | val register_fun3 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm) -> scm
430 | (** [register_fun3 fname ?no_opt ?rst f] exposes the OCaml function
431 | [f] to the Guile scheme context, under the name [fname].
432 |
433 | [no_opt] encodes the number of trailing arguments that are
434 | optional, and [rst] encodes whether the last argument should
435 | capture all extraneous arguments. *)
436 |
437 | val register_fun4 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm -> scm) -> scm
438 | (** [register_fun4 fname ?no_opt ?rst f] exposes the OCaml function
439 | [f] to the Guile scheme context, under the name [fname].
440 |
441 | [no_opt] encodes the number of trailing arguments that are
442 | optional, and [rst] encodes whether the last argument should
443 | capture all extraneous arguments. *)
444 |
445 | val register_fun5 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm -> scm -> scm) -> scm
446 | (** [register_fun5 fname ?no_opt ?rst f] exposes the OCaml function
447 | [f] to the Guile scheme context, under the name [fname].
448 |
449 | [no_opt] encodes the number of trailing arguments that are
450 | optional, and [rst] encodes whether the last argument should
451 | capture all extraneous arguments. *)
452 |
453 | val register_fun6 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm
454 | (** [register_fun6 fname ?no_opt ?rst f] exposes the OCaml function
455 | [f] to the Guile scheme context, under the name [fname].
456 |
457 | [no_opt] encodes the number of trailing arguments that are
458 | optional, and [rst] encodes whether the last argument should
459 | capture all extraneous arguments. *)
460 |
461 | val register_fun7 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm
462 | (** [register_fun7 fname ?no_opt ?rst f] exposes the OCaml function
463 | [f] to the Guile scheme context, under the name [fname].
464 |
465 | [no_opt] encodes the number of trailing arguments that are
466 | optional, and [rst] encodes whether the last argument should
467 | capture all extraneous arguments. *)
468 |
469 | val register_fun8 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm
470 | (** [register_fun8 fname ?no_opt ?rst f] exposes the OCaml function
471 | [f] to the Guile scheme context, under the name [fname].
472 |
473 | [no_opt] encodes the number of trailing arguments that are
474 | optional, and [rst] encodes whether the last argument should
475 | capture all extraneous arguments. *)
476 |
477 | val register_fun9 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm
478 | (** [register_fun9 fname ?no_opt ?rst f] exposes the OCaml function
479 | [f] to the Guile scheme context, under the name [fname].
480 |
481 | [no_opt] encodes the number of trailing arguments that are
482 | optional, and [rst] encodes whether the last argument should
483 | capture all extraneous arguments. *)
484 |
485 | val register_fun10 : string -> ?no_opt:int -> ?rst:bool -> (scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm -> scm) -> scm
486 | (** [register_fun10 fname ?no_opt ?rst f] exposes the OCaml function
487 | [f] to the Guile scheme context, under the name [fname].
488 |
489 | [no_opt] encodes the number of trailing arguments that are
490 | optional, and [rst] encodes whether the last argument should
491 | capture all extraneous arguments. *)
492 |
493 | end
494 |
495 | val eval : ?state:scm -> scm -> scm
496 | (** [eval ?state s] evaluates a Guile scheme s-expression [s] in execution state [state]. *)
497 |
498 | val eval_string : string -> scm
499 | (** [eval_string s] evaluates a string [s] as a Guile scheme s-expression *)
500 |
501 | val to_string : ?printer:scm -> scm -> string
502 | (** [to_string ?printer v] returns a string representation of a Guile scheme value [v]. *)
503 |
504 | module Sexp : sig
505 |
506 | val to_raw : Sexplib.Sexp.t -> scm
507 | (** [to_raw s] converts an s-expression [s] to a Guile scheme value. *)
508 |
509 | val from_raw : scm -> Sexplib.Sexp.t
510 | (** [from_raw s] extracts a Guile scheme value [s] into an OCaml
511 | s-expression. *)
512 |
513 | end
514 |
515 | module Module : sig
516 |
517 | val resolve : string -> scm
518 | (** [resolve name] finds the module named [name] and returns
519 | it. When it has not already been defined, try to auto-load
520 | it. When it can’t be found that way either, create an empty
521 | module. *)
522 |
523 | val with_current_module : modl:scm -> (unit -> unit) -> unit
524 | (** [with_current_module ~modl f] calls [f] and makes module [modl]
525 | the current module during the call. *)
526 |
527 | val lookup_variable : modl:string -> string -> scm
528 | (** [lookup_variable ~modl name] finds the variable bound to the
529 | symbol [name] in the public interface of the module [modl].
530 |
531 | [modl] should be a space separated string of module names *)
532 |
533 | val lookup : modl:string -> string -> scm
534 | (** [lookup ~modl name] finds value of the variable bound to the
535 | symbol [name] in the public interface of the module [modl].
536 |
537 | Throws a Guile exception if not found.
538 |
539 | [modl] should be a space separated string of module names *)
540 |
541 | val is_defined: ?modl:scm -> string -> bool
542 | (** [is_defined ~modl name] returns true if [name] is defined in the
543 | module [modl] or the current module when module is not specified;
544 | otherwise return false. *)
545 |
546 | val define_module : string -> (unit -> unit) -> scm
547 | (** [define_module modl f] defines a new module named [modl] and
548 | makes it current while [f] is called. Returns the module [modl]. *)
549 |
550 | val define : string -> scm -> unit
551 | (** [define name vl] binds the symbol indicated by [name] to a
552 | variable in the current module and set that variable to
553 | [vl]. When [name] is already bound to a variable, update
554 | that. Else create a new variable. *)
555 |
556 | val use : string -> scm
557 | (** [use modl] add the module [modl] to the uses list of the current
558 | module. *)
559 |
560 | val export : string -> unit
561 | (** [export name] adds the bindings designated by [name] to the
562 | public interface of the current module. *)
563 |
564 | end
565 |
--------------------------------------------------------------------------------
/lib/guile_stubs.c:
--------------------------------------------------------------------------------
1 | /*
2 | GNU Guile OCaml Bindings
3 |
4 | Copyright (C) 2021 Kiran Gopinathan
5 |
6 | This program is free software: you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation, either version 3 of the License, or
9 | (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with this program. If not, see .
18 | */
19 |
20 | #include "libguile.h"
21 |
22 | int linkme() {
23 | return 42;
24 | }
25 |
26 | void scm_setcar(SCM pair, SCM x) {
27 | SCM_SETCAR(pair, x);
28 | }
29 |
30 | void scm_setcdr(SCM pair, SCM x) {
31 | SCM_SETCDR(pair, x);
32 | }
33 |
34 | SCM scm_from_bool_(int v) {
35 | return scm_from_bool(v);
36 | }
37 |
38 | char scm_to_char_(SCM v) {
39 | return scm_to_char(v);
40 | }
41 |
42 | signed char scm_to_schar_(SCM v) {
43 | return scm_to_schar(v);
44 | }
45 |
46 | unsigned char scm_to_uchar_(SCM v) {
47 | return scm_to_uchar(v);
48 | }
49 |
50 | short scm_to_short_(SCM v) {
51 | return scm_to_short(v);
52 | }
53 |
54 | unsigned short scm_to_ushort_(SCM v) {
55 | return scm_to_ushort(v);
56 | }
57 |
58 | int scm_to_int_(SCM v) {
59 | return scm_to_int(v);
60 | }
61 |
62 | unsigned int scm_to_uint_(SCM v) {
63 | return scm_to_uint(v);
64 | }
65 |
66 | long scm_to_long_(SCM v) {
67 | return scm_to_long(v);
68 | }
69 |
70 | unsigned long scm_to_ulong_(SCM v) {
71 | return scm_to_ulong(v);
72 | }
73 |
74 | long long scm_to_long_long_(SCM v) {
75 | return scm_to_long_long(v);
76 | }
77 |
78 | unsigned long long scm_to_ulong_long_(SCM v) {
79 | return scm_to_ulong_long(v);
80 | }
81 |
82 | size_t scm_to_size_t_(SCM v) {
83 | return scm_to_size_t(v);
84 | }
85 |
86 | SCM scm_from_char_(char v) {
87 | return scm_from_char(v);
88 | }
89 |
90 | SCM scm_from_schar_(signed char v) {
91 | return scm_from_schar(v);
92 | }
93 |
94 | SCM scm_from_uchar_(unsigned char v) {
95 | return scm_from_uchar(v);
96 | }
97 |
98 | SCM scm_from_short_(short v) {
99 | return scm_from_short(v);
100 | }
101 |
102 | SCM scm_from_ushort_(unsigned short v) {
103 | return scm_from_ushort(v);
104 | }
105 |
106 | SCM scm_from_int_(int v) {
107 | return scm_from_int(v);
108 | }
109 |
110 | SCM scm_from_uint_(unsigned int v) {
111 | return scm_from_uint(v);
112 | }
113 |
114 | SCM scm_from_long_(long v) {
115 | return scm_from_long(v);
116 | }
117 |
118 | SCM scm_from_ulong_(unsigned long v) {
119 | return scm_from_ulong(v);
120 | }
121 |
122 | SCM scm_from_long_long_(long long v) {
123 | return scm_from_long_long(v);
124 | }
125 |
126 | SCM scm_from_ulong_long_(unsigned long long v) {
127 | return scm_from_ulong_long(v);
128 | }
129 |
130 | SCM scm_from_size_t_(size_t v) {
131 | return scm_from_size_t(v);
132 | }
133 |
134 | int scm_is_eq_(SCM x, SCM y) {
135 | return scm_is_eq(x,y);
136 | }
137 |
138 | int scm_is_null_(SCM x) {
139 | return scm_is_null(x);
140 | }
141 |
142 |
--------------------------------------------------------------------------------
/lib/raw.ml:
--------------------------------------------------------------------------------
1 | (*
2 | GNU Guile OCaml Bindings
3 |
4 | Copyright (C) 2021 Kiran Gopinathan
5 |
6 | This program is free software: you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation, either version 3 of the License, or
9 | (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with this program. If not, see .
18 | *)
19 |
20 | module Bindings = Bindings.Stubs(Bindings_stubs)
21 | open Ctypes
22 | external linkme : unit -> int = "linkme"
23 |
24 | let scm = ptr void
25 | type scm = unit ptr
26 | (** SCM is the user level abstract C type that is used to represent
27 | all of Guile’s Scheme objects, no matter what the Scheme object
28 | type is. No C operation except assignment is guaranteed to work
29 | with variables of type SCM, so you should only use macros and
30 | functions to work with SCM values. Values are converted between C
31 | data types and the SCM type with utility functions and macros. *)
32 |
33 | let guile_void_callback =
34 | Foreign.funptr ~thread_registration:true
35 | (ptr void @-> returning (ptr void))
36 | let guile_handler_callback =
37 | Foreign.funptr ~thread_registration:true
38 | (ptr void @-> scm @-> scm @-> returning scm)
39 |
40 | module GuileCallback1 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> returning (scm)))
41 | module GuileCallback2 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> returning (scm)))
42 | module GuileCallback3 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> returning (scm)))
43 | module GuileCallback4 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> scm @-> returning (scm)))
44 | module GuileCallback5 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> scm @-> scm @-> returning (scm)))
45 | module GuileCallback6 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning (scm)))
46 | module GuileCallback7 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning (scm)))
47 | module GuileCallback8 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning (scm)))
48 | module GuileCallback9 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning (scm)))
49 | module GuileCallback10 = (val Foreign.dynamic_funptr ~thread_registration:true (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning (scm)))
50 |
51 | let scm_with_guile =
52 | Foreign.foreign "scm_with_guile"
53 | (guile_void_callback @-> ptr void @-> returning (ptr void))
54 | let scm_with_guile f v =
55 | scm_with_guile f v
56 |
57 | let scm_init_guile =
58 | Foreign.foreign "scm_init_guile"
59 | (void @-> returning void)
60 |
61 | let scm_shell =
62 | Foreign.foreign "scm_shell"
63 | (int @-> ptr string @-> returning void)
64 |
65 | let scm_shell argv =
66 | let argc = Array.length argv in
67 | let argv = Ctypes.CArray.of_list string (Array.to_list argv) in
68 | scm_shell argc (CArray.start argv)
69 |
70 | let scm_primitive_load = Foreign.foreign "scm_c_primitive_load" (string @-> returning scm)
71 |
72 | (* ==================================================================== *)
73 | (* Modules *)
74 | (* ==================================================================== *)
75 | let scm_resolve_module = Foreign.foreign "scm_c_resolve_module" (string @-> returning scm)
76 | let scm_use_module = Foreign.foreign "scm_c_use_module" (string @-> returning scm)
77 | let scm_define_module = Foreign.foreign "scm_c_define_module" (string @-> guile_void_callback @-> ptr void @-> returning scm)
78 | let scm_export = Foreign.foreign "scm_c_export" (string @-> ptr void @-> returning void)
79 | let scm_variable = Foreign.foreign "scm_c_public_variable" (string @-> string @-> returning scm)
80 | let scm_variable_ref = Foreign.foreign "scm_c_public_ref" (string @-> string @-> returning scm)
81 | let scm_call_with_current_module =
82 | Foreign.foreign "scm_c_call_with_current_module" (scm @-> guile_void_callback @-> ptr void @-> returning scm)
83 |
84 | (* ==================================================================== *)
85 | (* Bindings *)
86 | (* ==================================================================== *)
87 |
88 | let scm_define = Foreign.foreign "scm_c_define" (string @-> scm @-> returning void)
89 | let scm_defined_p = Foreign.foreign "scm_defined_p" (scm @-> scm @-> returning scm)
90 |
91 | (* ==================================================================== *)
92 | (* Control flow *)
93 | (* ==================================================================== *)
94 |
95 | let scm_with_continuation_barrier =
96 | Foreign.foreign "scm_c_with_continuation_barrier"
97 | (guile_void_callback @-> ptr void @-> returning (ptr void))
98 | let scm_with_continuation_barrier f v =
99 | scm_with_continuation_barrier f v
100 |
101 | let scm_error = Foreign.foreign "scm_error" (scm @-> string_opt @-> string_opt @-> scm @-> scm @-> returning scm)
102 |
103 | let scm_c_catch = Foreign.foreign "scm_internal_catch" (scm @-> guile_void_callback @-> ptr void @-> guile_handler_callback @-> ptr void @-> returning scm)
104 |
105 | (* ==================================================================== *)
106 | (* FFI *)
107 | (* ==================================================================== *)
108 |
109 | let scm_pointer_to_procedure =
110 | Foreign.foreign "scm_pointer_to_procedure" (scm @-> scm @-> scm @-> returning scm)
111 |
112 | let scm_define_gsubr_1 =
113 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback1.t @-> returning scm)
114 | let scm_define_gsubr_1 name ?(no_opt=0) ?(rst=false) f =
115 | let rst = Bool.to_int rst in
116 | let no_required = 1 - no_opt - rst in
117 | scm_define_gsubr_1 name no_required no_opt rst (GuileCallback1.of_fun f)
118 |
119 | let scm_define_gsubr_2 =
120 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback2.t @-> returning scm)
121 | let scm_define_gsubr_2 name ?(no_opt=0) ?(rst=false) f =
122 | let rst = Bool.to_int rst in
123 | let no_required = 2 - no_opt - rst in
124 | scm_define_gsubr_2 name no_required no_opt rst (GuileCallback2.of_fun f)
125 |
126 | let scm_define_gsubr_3 =
127 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback3.t @-> returning scm)
128 | let scm_define_gsubr_3 name ?(no_opt=0) ?(rst=false) f =
129 | let rst = Bool.to_int rst in
130 | let no_required = 3 - no_opt - rst in
131 | scm_define_gsubr_3 name no_required no_opt rst (GuileCallback3.of_fun f)
132 |
133 | let scm_define_gsubr_4 =
134 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback4.t @-> returning scm)
135 | let scm_define_gsubr_4 name ?(no_opt=0) ?(rst=false) f =
136 | let rst = Bool.to_int rst in
137 | let no_required = 4 - no_opt - rst in
138 | scm_define_gsubr_4 name no_required no_opt rst (GuileCallback4.of_fun f)
139 |
140 | let scm_define_gsubr_5 =
141 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback5.t @-> returning scm)
142 | let scm_define_gsubr_5 name ?(no_opt=0) ?(rst=false) f =
143 | let rst = Bool.to_int rst in
144 | let no_required = 5 - no_opt - rst in
145 | scm_define_gsubr_5 name no_required no_opt rst (GuileCallback5.of_fun f)
146 |
147 | let scm_define_gsubr_6 =
148 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback6.t @-> returning scm)
149 | let scm_define_gsubr_6 name ?(no_opt=0) ?(rst=false) f =
150 | let rst = Bool.to_int rst in
151 | let no_required = 6 - no_opt - rst in
152 | scm_define_gsubr_6 name no_required no_opt rst (GuileCallback6.of_fun f)
153 |
154 | let scm_define_gsubr_7 =
155 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback7.t @-> returning scm)
156 | let scm_define_gsubr_7 name ?(no_opt=0) ?(rst=false) f =
157 | let rst = Bool.to_int rst in
158 | let no_required = 7 - no_opt - rst in
159 | scm_define_gsubr_7 name no_required no_opt rst (GuileCallback7.of_fun f)
160 |
161 | let scm_define_gsubr_8 =
162 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback8.t @-> returning scm)
163 | let scm_define_gsubr_8 name ?(no_opt=0) ?(rst=false) f =
164 | let rst = Bool.to_int rst in
165 | let no_required = 8 - no_opt - rst in
166 | scm_define_gsubr_8 name no_required no_opt rst (GuileCallback8.of_fun f)
167 |
168 | let scm_define_gsubr_9 =
169 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback9.t @-> returning scm)
170 | let scm_define_gsubr_9 name ?(no_opt=0) ?(rst=false) f =
171 | let rst = Bool.to_int rst in
172 | let no_required = 9 - no_opt - rst in
173 | scm_define_gsubr_9 name no_required no_opt rst (GuileCallback9.of_fun f)
174 |
175 | let scm_define_gsubr_10 =
176 | Foreign.foreign "scm_c_define_gsubr" (string @-> int @-> int @-> int @-> GuileCallback10.t @-> returning scm)
177 | let scm_define_gsubr_10 name ?(no_opt=0) ?(rst=false) f =
178 | let rst = Bool.to_int rst in
179 | let no_required = 10 - no_opt - rst in
180 | scm_define_gsubr_10 name no_required no_opt rst (GuileCallback10.of_fun f)
181 |
182 | (* ==================================================================== *)
183 | (* Equality *)
184 | (* ==================================================================== *)
185 | let scm_eq_p : scm -> scm -> scm = Foreign.foreign "scm_eq_p" (scm @-> scm @-> returning scm)
186 | let scm_is_eq : scm -> scm -> bool = Foreign.foreign "scm_is_eq_" (scm @-> scm @-> returning bool)
187 |
188 | let scm_eqv_p : scm -> scm -> scm = Foreign.foreign "scm_eqv_p" (scm @-> scm @-> returning scm)
189 |
190 | let scm_equal_p : scm -> scm -> scm = Foreign.foreign "scm_equal_p" (scm @-> scm @-> returning scm)
191 |
192 | let scm_object_to_string: scm -> scm -> scm = Foreign.foreign "scm_object_to_string" (scm @-> scm @-> returning scm)
193 |
194 |
195 | (* ==================================================================== *)
196 | (* Evaluation *)
197 | (* ==================================================================== *)
198 |
199 | let scm_eval: scm -> scm -> scm = Foreign.foreign "scm_eval" (scm @-> scm @-> returning scm)
200 |
201 | let scm_interaction_environment: unit -> scm = Foreign.foreign "scm_interaction_environment" (void @-> returning scm)
202 |
203 | let scm_eval_string : scm -> scm = Foreign.foreign "scm_eval_string" (scm @-> returning scm)
204 |
205 | (* ==================================================================== *)
206 | (* Boolean *)
207 | (* ==================================================================== *)
208 |
209 | let scm_not : scm -> scm = Foreign.foreign "scm_not" (scm @-> returning scm)
210 |
211 | let scm_boolean_p : scm -> scm = Foreign.foreign "scm_boolean_p" (scm @-> returning scm)
212 |
213 | (* let scm_is_true : scm -> bool = Foreign.foreign "scm_is_true" (scm @-> returning bool) *)
214 |
215 | (* let scm_is_false : scm -> bool = Foreign.foreign "scm_is_false" (scm @-> returning bool) *)
216 |
217 | let scm_is_bool : scm -> bool = Foreign.foreign "scm_is_bool" (scm @-> returning bool)
218 |
219 | let scm_from_bool : bool -> scm = Foreign.foreign "scm_from_bool_" (bool @-> returning scm)
220 |
221 | let scm_to_bool : scm -> bool = Foreign.foreign "scm_to_bool" (scm @-> returning bool)
222 |
223 | (* ==================================================================== *)
224 | (* Numbers *)
225 | (* ==================================================================== *)
226 |
227 | let scm_number_p : scm -> scm = Foreign.foreign "scm_number_p" (scm @-> returning scm)
228 | let scm_is_number : scm -> bool = Foreign.foreign "scm_is_number" (scm @-> returning bool)
229 |
230 | let scm_integer_p : scm -> scm = Foreign.foreign "scm_integer_p" (scm @-> returning scm)
231 | let scm_is_integer : scm -> bool = Foreign.foreign "scm_is_integer" (scm @-> returning bool)
232 |
233 | let scm_exact_integer_p : scm -> scm = Foreign.foreign "scm_exact_integer_p" (scm @-> returning scm)
234 | let scm_is_exact_integer : scm -> bool = Foreign.foreign "scm_is_exact_integer" (scm @-> returning bool)
235 |
236 | let scm_to_char : scm -> char = Foreign.foreign "scm_to_char_" (scm @-> returning char)
237 | let scm_to_schar : scm -> int = Foreign.foreign "scm_to_schar_" (scm @-> returning schar)
238 | let scm_to_uchar : scm -> Unsigned.UChar.t = Foreign.foreign "scm_to_uchar_" (scm @-> returning uchar)
239 | let scm_to_short : scm -> int = Foreign.foreign "scm_to_short_" (scm @-> returning short)
240 | let scm_to_ushort : scm -> Unsigned.UShort.t = Foreign.foreign "scm_to_ushort_" (scm @-> returning ushort)
241 | let scm_to_int : scm -> int = Foreign.foreign "scm_to_int_" (scm @-> returning int)
242 | let scm_to_uint : scm -> Unsigned.UInt.t = Foreign.foreign "scm_to_uint_" (scm @-> returning uint)
243 | let scm_to_long : scm -> Signed.Long.t = Foreign.foreign "scm_to_long_" (scm @-> returning long)
244 | let scm_to_ulong : scm -> Unsigned.ULong.t = Foreign.foreign "scm_to_ulong_" (scm @-> returning ulong)
245 | let scm_to_long_long : scm -> Signed.LLong.t = Foreign.foreign "scm_to_long_long_" (scm @-> returning llong)
246 | let scm_to_ulong_long : scm -> Unsigned.ULLong.t = Foreign.foreign "scm_to_ulong_long_" (scm @-> returning ullong)
247 | let scm_to_size_t : scm -> Unsigned.Size_t.t = Foreign.foreign "scm_to_size_t_" (scm @-> returning size_t)
248 |
249 | let scm_from_char : char -> scm = Foreign.foreign "scm_from_char_" ( char @-> returning scm)
250 | let scm_from_schar : int -> scm = Foreign.foreign "scm_from_schar_" ( schar @-> returning scm)
251 | let scm_from_uchar : Unsigned.UChar.t -> scm = Foreign.foreign "scm_from_uchar_" ( uchar @-> returning scm)
252 | let scm_from_short : int -> scm = Foreign.foreign "scm_from_short_" ( short @-> returning scm)
253 | let scm_from_ushort : Unsigned.UShort.t -> scm = Foreign.foreign "scm_from_ushort_" ( ushort @-> returning scm)
254 | let scm_from_int : int -> scm = Foreign.foreign "scm_from_int_" ( int @-> returning scm)
255 | let scm_from_uint : Unsigned.UInt.t -> scm = Foreign.foreign "scm_from_uint_" ( uint @-> returning scm)
256 | let scm_from_long : Signed.Long.t -> scm = Foreign.foreign "scm_from_long_" ( long @-> returning scm)
257 | let scm_from_ulong : Unsigned.ULong.t -> scm = Foreign.foreign "scm_from_ulong_" ( ulong @-> returning scm)
258 | let scm_from_long_long : Signed.LLong.t -> scm = Foreign.foreign "scm_from_long_long_" ( llong @-> returning scm)
259 | let scm_from_ulong_long : Unsigned.ULLong.t -> scm = Foreign.foreign "scm_from_ulong_long_" ( ullong @-> returning scm)
260 | let scm_from_size_t : Unsigned.Size_t.t -> scm = Foreign.foreign "scm_from_size_t_" ( size_t @-> returning scm)
261 |
262 | (* ==================================================================== *)
263 | (* Real *)
264 | (* ==================================================================== *)
265 |
266 | let scm_real_p : scm -> scm = Foreign.foreign "scm_real_p" (scm @-> returning scm)
267 | let scm_is_real : scm -> bool = Foreign.foreign "scm_is_real" (scm @-> returning bool)
268 |
269 | let scm_rational_p : scm -> scm = Foreign.foreign "scm_rational_p" (scm @-> returning scm)
270 | let scm_is_rational : scm -> bool = Foreign.foreign "scm_is_rational" (scm @-> returning bool)
271 |
272 | let scm_rationalize : scm -> scm -> scm = Foreign.foreign "scm_rationalize" (scm @-> scm @-> returning scm)
273 |
274 | let scm_inf_p : scm -> scm = Foreign.foreign "scm_inf_p" (scm @-> returning scm)
275 | let scm_nan_p : scm -> scm = Foreign.foreign "scm_nan_p" (scm @-> returning scm)
276 | let scm_finite_p : scm -> scm = Foreign.foreign "scm_finite_p" (scm @-> returning scm)
277 |
278 | let scm_nan : unit -> scm = Foreign.foreign "scm_nan" (void @-> returning scm)
279 | let scm_inf : unit -> scm = Foreign.foreign "scm_inf" (void @-> returning scm)
280 |
281 | let scm_numerator : scm -> scm = Foreign.foreign "scm_numerator" (scm @-> returning scm)
282 | let scm_denominator : scm -> scm = Foreign.foreign "scm_denominator" (scm @-> returning scm)
283 |
284 | let scm_to_double : scm -> float = Foreign.foreign "scm_to_double" (scm @-> returning double)
285 | let scm_from_double : float -> scm = Foreign.foreign "scm_from_double" (double @-> returning scm)
286 |
287 | (* ==================================================================== *)
288 | (* Complex *)
289 | (* ==================================================================== *)
290 |
291 | let scm_complex_p : scm -> scm = Foreign.foreign "scm_complex_p" (scm @-> returning scm)
292 | let scm_is_complex : scm -> bool = Foreign.foreign "scm_is_complex" (scm @-> returning bool)
293 |
294 | (* ==================================================================== *)
295 | (* Exact *)
296 | (* ==================================================================== *)
297 |
298 | let scm_exact_p : scm -> scm = Foreign.foreign "scm_exact_p" (scm @-> returning scm)
299 | let scm_is_exact : scm -> bool = Foreign.foreign "scm_is_exact" (scm @-> returning bool)
300 |
301 | let scm_inexact_p : scm -> scm = Foreign.foreign "scm_inexact_p" (scm @-> returning scm)
302 | let scm_is_inexact : scm -> bool = Foreign.foreign "scm_is_inexact" (scm @-> returning bool)
303 |
304 | let scm_inexact_to_exact : scm -> scm = Foreign.foreign "scm_inexact_to_exact" (scm @-> returning scm)
305 | let scm_exact_to_inexact : scm -> scm = Foreign.foreign "scm_exact_to_inexact" (scm @-> returning scm)
306 |
307 | let scm_odd_p : scm -> scm = Foreign.foreign "scm_odd_p" (scm @-> returning scm)
308 | let scm_even_p : scm -> scm = Foreign.foreign "scm_even_p" (scm @-> returning scm)
309 |
310 | let scm_quotient : scm -> scm -> scm = Foreign.foreign "scm_quotient" (scm @-> scm @-> returning scm)
311 | let scm_remainder : scm -> scm -> scm = Foreign.foreign "scm_remainder" (scm @-> scm @-> returning scm)
312 | let scm_modulo : scm -> scm -> scm = Foreign.foreign "scm_modulo" (scm @-> scm @-> returning scm)
313 | let scm_gcd : scm -> scm -> scm = Foreign.foreign "scm_gcd" (scm @-> scm @-> returning scm)
314 | let scm_lcm : scm -> scm -> scm = Foreign.foreign "scm_lcm" (scm @-> scm @-> returning scm)
315 |
316 | let scm_modulo_expt : scm -> scm -> scm -> scm = Foreign.foreign "scm_modulo_expt" (scm @-> scm @-> scm @-> returning scm)
317 | let scm_exact_integer_sqrt : scm -> scm ptr -> scm ptr -> unit =
318 | Foreign.foreign "scm_exact_integer_sqrt" (scm @-> ptr scm @-> ptr scm @-> returning void)
319 |
320 | let scm_num_eq_p : scm -> scm -> scm = Foreign.foreign "scm_num_eq_p" (scm @-> scm @-> returning scm)
321 | let scm_less_p : scm -> scm -> scm = Foreign.foreign "scm_less_p" (scm @-> scm @-> returning scm)
322 | let scm_gr_p : scm -> scm -> scm = Foreign.foreign "scm_gr_p" (scm @-> scm @-> returning scm)
323 | let scm_leq_p : scm -> scm -> scm = Foreign.foreign "scm_leq_p" (scm @-> scm @-> returning scm)
324 | let scm_geq_p : scm -> scm -> scm = Foreign.foreign "scm_geq_p" (scm @-> scm @-> returning scm)
325 |
326 | let scm_zero_p : scm -> scm = Foreign.foreign "scm_zero_p" (scm @-> returning scm)
327 | let scm_positive_p : scm -> scm = Foreign.foreign "scm_positive_p" (scm @-> returning scm)
328 | let scm_negative_p : scm -> scm = Foreign.foreign "scm_negative_p" (scm @-> returning scm)
329 |
330 | let scm_number_to_string : scm -> scm -> scm = Foreign.foreign "scm_number_to_string" (scm @-> scm @-> returning scm)
331 | let scm_string_to_number : scm -> scm -> scm = Foreign.foreign "scm_string_to_number" (scm @-> scm @-> returning scm)
332 |
333 | let scm_make_rectangular : scm -> scm -> scm = Foreign.foreign "scm_make_rectangular" (scm @-> scm @-> returning scm)
334 | let scm_make_poloar : scm -> scm -> scm = Foreign.foreign "scm_make_polar" (scm @-> scm @-> returning scm)
335 |
336 | let scm_real_part : scm -> scm = Foreign.foreign "scm_real_part" (scm @-> returning scm)
337 | let scm_imag_part : scm -> scm = Foreign.foreign "scm_imag_part" (scm @-> returning scm)
338 |
339 | let scm_magnitude : scm -> scm = Foreign.foreign "scm_magnitude" (scm @-> returning scm)
340 | let scm_angle : scm -> scm = Foreign.foreign "scm_angle" (scm @-> returning scm)
341 |
342 | let scm_sum : scm -> scm -> scm = Foreign.foreign "scm_sum" (scm @-> scm @-> returning scm)
343 | let scm_difference : scm -> scm -> scm = Foreign.foreign "scm_difference" (scm @-> scm @-> returning scm)
344 | let scm_product : scm -> scm -> scm = Foreign.foreign "scm_product" (scm @-> scm @-> returning scm)
345 | let scm_divide : scm -> scm -> scm = Foreign.foreign "scm_divide" (scm @-> scm @-> returning scm)
346 | let scm_oneplus : scm -> scm -> scm = Foreign.foreign "scm_oneplus" (scm @-> scm @-> returning scm)
347 | let scm_oneminus : scm -> scm -> scm = Foreign.foreign "scm_oneminus" (scm @-> scm @-> returning scm)
348 | let scm_abs : scm -> scm -> scm = Foreign.foreign "scm_abs" (scm @-> scm @-> returning scm)
349 | let scm_max : scm -> scm -> scm = Foreign.foreign "scm_max" (scm @-> scm @-> returning scm)
350 | let scm_min : scm -> scm -> scm = Foreign.foreign "scm_min" (scm @-> scm @-> returning scm)
351 | let scm_truncate : scm -> scm -> scm = Foreign.foreign "scm_truncate_number" (scm @-> scm @-> returning scm)
352 | let scm_round : scm -> scm -> scm = Foreign.foreign "scm_round_number" (scm @-> scm @-> returning scm)
353 | let scm_floor : scm -> scm -> scm = Foreign.foreign "scm_floor" (scm @-> scm @-> returning scm)
354 | let scm_ceiling : scm -> scm -> scm = Foreign.foreign "scm_ceiling" (scm @-> scm @-> returning scm)
355 |
356 | let scm_euclidean_divide : scm -> scm -> scm ptr -> scm ptr -> unit =
357 | Foreign.foreign "scm_euclidean_divide" (scm @-> scm @-> ptr scm @-> ptr scm @-> returning void)
358 | let scm_euclidean_quotient : scm -> scm -> scm =
359 | Foreign.foreign "scm_euclidean_quotient" (scm @-> scm @-> returning scm)
360 | let scm_euclidean_remainder : scm -> scm -> scm =
361 | Foreign.foreign "scm_euclidean_remainder" (scm @-> scm @-> returning scm)
362 |
363 | let scm_floor_divide : scm -> scm -> scm ptr -> scm ptr -> unit =
364 | Foreign.foreign "scm_floor_divide" (scm @-> scm @-> ptr scm @-> ptr scm @-> returning void)
365 | let scm_floor_quotient : scm -> scm -> scm =
366 | Foreign.foreign "scm_floor_quotient" (scm @-> scm @-> returning scm)
367 | let scm_floor_remainder : scm -> scm -> scm =
368 | Foreign.foreign "scm_floor_remainder" (scm @-> scm @-> returning scm)
369 |
370 | let scm_ceiling_divide : scm -> scm -> scm ptr -> scm ptr -> unit =
371 | Foreign.foreign "scm_ceiling_divide" (scm @-> scm @-> ptr scm @-> ptr scm @-> returning void)
372 | let scm_ceiling_quotient : scm -> scm -> scm =
373 | Foreign.foreign "scm_ceiling_quotient" (scm @-> scm @-> returning scm)
374 | let scm_ceiling_remainder : scm -> scm -> scm =
375 | Foreign.foreign "scm_ceiling_remainder" (scm @-> scm @-> returning scm)
376 |
377 | let scm_truncate_divide : scm -> scm -> scm ptr -> scm ptr -> unit =
378 | Foreign.foreign "scm_truncate_divide" (scm @-> scm @-> ptr scm @-> ptr scm @-> returning void)
379 | let scm_truncate_quotient : scm -> scm -> scm =
380 | Foreign.foreign "scm_truncate_quotient" (scm @-> scm @-> returning scm)
381 | let scm_truncate_remainder : scm -> scm -> scm =
382 | Foreign.foreign "scm_truncate_remainder" (scm @-> scm @-> returning scm)
383 |
384 | let scm_centered_divide : scm -> scm -> scm ptr -> scm ptr -> unit =
385 | Foreign.foreign "scm_centered_divide" (scm @-> scm @-> ptr scm @-> ptr scm @-> returning void)
386 | let scm_centered_quotient : scm -> scm -> scm =
387 | Foreign.foreign "scm_centered_quotient" (scm @-> scm @-> returning scm)
388 | let scm_centered_remainder : scm -> scm -> scm =
389 | Foreign.foreign "scm_centered_remainder" (scm @-> scm @-> returning scm)
390 |
391 | let scm_round_divide : scm -> scm -> scm ptr -> scm ptr -> unit =
392 | Foreign.foreign "scm_round_divide" (scm @-> scm @-> ptr scm @-> ptr scm @-> returning void)
393 | let scm_round_quotient : scm -> scm -> scm =
394 | Foreign.foreign "scm_round_quotient" (scm @-> scm @-> returning scm)
395 | let scm_round_remainder : scm -> scm -> scm =
396 | Foreign.foreign "scm_round_remainder" (scm @-> scm @-> returning scm)
397 |
398 | let scm_logand : scm -> scm -> scm = Foreign.foreign "scm_logand" (scm @-> scm @-> returning scm)
399 | let scm_logior : scm -> scm -> scm = Foreign.foreign "scm_logior" (scm @-> scm @-> returning scm)
400 | let scm_logxor : scm -> scm -> scm = Foreign.foreign "scm_logxor" (scm @-> scm @-> returning scm)
401 | let scm_lognot : scm -> scm = Foreign.foreign "scm_lognot" (scm @-> returning scm)
402 | let scm_logtest : scm -> scm -> scm = Foreign.foreign "scm_logtest" (scm @-> scm @-> returning scm)
403 | let scm_logbit_p : scm -> scm -> scm = Foreign.foreign "scm_logbit_p" (scm @-> scm @-> returning scm)
404 | let scm_ash : scm -> scm -> scm = Foreign.foreign "scm_ash" (scm @-> scm @-> returning scm)
405 | let scm_round_ash : scm -> scm -> scm = Foreign.foreign "scm_round_ash" (scm @-> scm @-> returning scm)
406 | let scm_logcount : scm -> scm = Foreign.foreign "scm_logcount" (scm @-> returning scm)
407 | let scm_integer_length : scm -> scm = Foreign.foreign "scm_integer_length" (scm @-> returning scm)
408 | let scm_integer_expt : scm -> scm -> scm = Foreign.foreign "scm_integer_expt" (scm @-> scm @-> returning scm)
409 | let scm_bit_extract : scm -> scm -> scm -> scm = Foreign.foreign "scm_bit_extract" (scm @-> scm @-> scm @-> returning scm)
410 |
411 | let scm_copy_random_state : scm -> scm = Foreign.foreign "scm_copy_random_state" (scm @-> returning scm)
412 | let scm_random : scm -> scm -> scm = Foreign.foreign "scm_random" (scm @-> scm @-> returning scm)
413 | let scm_random_exp : scm -> scm = Foreign.foreign "scm_random_exp" (scm @-> returning scm)
414 | let scm_random_hollow_sphere_x : scm -> scm -> scm = Foreign.foreign "scm_random_hollow_sphere_x" (scm @-> scm @-> returning scm)
415 | let scm_random_normal : scm -> scm = Foreign.foreign "scm_random_normal" (scm @-> returning scm)
416 | let scm_random_normal_vector_x : scm -> scm -> scm = Foreign.foreign "scm_random_normal_vector_x" (scm @-> scm @-> returning scm)
417 | let scm_random_solid_sphere_x : scm -> scm -> scm = Foreign.foreign "scm_random_solid_sphere_x" (scm @-> scm @-> returning scm)
418 | let scm_random_uniform : scm -> scm = Foreign.foreign "scm_random_uniform" (scm @-> returning scm)
419 | let scm_seed_to_random_state : scm -> scm = Foreign.foreign "scm_seed_to_random_state" (scm @-> returning scm)
420 | let scm_datum_to_random_state : scm -> scm = Foreign.foreign "scm_datum_to_random_state" (scm @-> returning scm)
421 | let scm_random_state_to_datum : scm -> scm = Foreign.foreign "scm_random_state_to_datum" (scm @-> returning scm)
422 | let scm_random_state_from_platform : scm -> scm = Foreign.foreign "scm_random_state_from_platform" (scm @-> returning scm)
423 |
424 | let scm_char_p : scm -> scm = Foreign.foreign "scm_char_p" (scm @-> returning scm)
425 | let scm_char_alphabetic_p : scm -> scm = Foreign.foreign "scm_char_alphabetic_p" (scm @-> returning scm)
426 | let scm_char_numeric_p : scm -> scm = Foreign.foreign "scm_char_numeric_p" (scm @-> returning scm)
427 | let scm_char_whitespace_p : scm -> scm = Foreign.foreign "scm_char_whitespace_p" (scm @-> returning scm)
428 | let scm_char_upper_case_p : scm -> scm = Foreign.foreign "scm_char_upper_case_p" (scm @-> returning scm)
429 | let scm_char_lower_case_p : scm -> scm = Foreign.foreign "scm_char_lower_case_p" (scm @-> returning scm)
430 | let scm_char_is_both_p : scm -> scm = Foreign.foreign "scm_char_is_both_p" (scm @-> returning scm)
431 | let scm_char_general_category : scm -> scm = Foreign.foreign "scm_char_general_category" (scm @-> returning scm)
432 | let scm_char_to_integer : scm -> scm = Foreign.foreign "scm_char_to_integer" (scm @-> returning scm)
433 | let scm_integer_to_char : scm -> scm = Foreign.foreign "scm_integer_to_char" (scm @-> returning scm)
434 | let scm_char_upcase : scm -> scm = Foreign.foreign "scm_char_upcase" (scm @-> returning scm)
435 | let scm_char_downcase : scm -> scm = Foreign.foreign "scm_char_downcase" (scm @-> returning scm)
436 | let scm_char_titlecase : scm -> scm = Foreign.foreign "scm_char_titlecase" (scm @-> returning scm)
437 |
438 |
439 | (* ==================================================================== *)
440 | (* String *)
441 | (* ==================================================================== *)
442 | let scm_string_p : scm -> scm = Foreign.foreign "scm_string_p" (scm @-> returning scm)
443 | let scm_is_string : scm -> bool = Foreign.foreign "scm_is_string" (scm @-> returning bool)
444 |
445 | let scm_string_null_p : scm -> scm = Foreign.foreign "scm_string_null_p" (scm @-> returning scm)
446 |
447 | let scm_string : scm -> scm = Foreign.foreign "scm_string" (scm @-> returning scm)
448 |
449 | let scm_reverse_list_to_string : scm -> scm = Foreign.foreign "scm_reverse_list_to_string" (scm @-> returning scm)
450 |
451 | let scm_make_string : scm -> scm -> scm = Foreign.foreign "scm_make_string" (scm @-> scm @-> returning scm)
452 |
453 | let scm_string_join : scm -> scm -> scm -> scm = Foreign.foreign "scm_string_join" (scm @-> scm @-> scm @-> returning scm)
454 |
455 | let scm_substring_to_list : scm -> scm -> scm -> scm = Foreign.foreign "scm_substring_to_list" (scm @-> scm @-> scm @-> returning scm)
456 |
457 | let scm_string_to_list : scm -> scm = Foreign.foreign "scm_string_to_list" (scm @-> returning scm)
458 |
459 | let scm_string_split : scm -> scm -> scm = Foreign.foreign "scm_string_split" (scm @-> scm @-> returning scm)
460 |
461 | let scm_string_length : scm -> scm = Foreign.foreign "scm_string_length" (scm @-> returning scm)
462 | let scm_c_string_length : scm -> Unsigned.size_t = Foreign.foreign "scm_c_string_length" (scm @-> returning size_t)
463 |
464 | let scm_substring_copy : scm -> scm -> scm -> scm = Foreign.foreign "scm_substring_copy" (scm @-> scm @-> scm @-> returning scm)
465 |
466 | let scm_string_copy : scm -> scm = Foreign.foreign "scm_string_copy" (scm @-> returning scm)
467 |
468 | let scm_substring : scm -> scm -> scm -> scm = Foreign.foreign "scm_string_copy" (scm @-> scm @-> scm @-> returning scm)
469 |
470 | let scm_string_eq : scm -> scm -> scm -> scm -> scm -> scm -> scm =
471 | Foreign.foreign "scm_string_eq" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
472 |
473 | let scm_string_neq : scm -> scm -> scm -> scm -> scm -> scm -> scm =
474 | Foreign.foreign "scm_string_neq" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
475 |
476 | let scm_string_lt : scm -> scm -> scm -> scm -> scm -> scm -> scm =
477 | Foreign.foreign "scm_string_lt" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
478 |
479 | let scm_string_gt : scm -> scm -> scm -> scm -> scm -> scm -> scm =
480 | Foreign.foreign "scm_string_gt" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
481 |
482 | let scm_string_le : scm -> scm -> scm -> scm -> scm -> scm -> scm =
483 | Foreign.foreign "scm_string_le" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
484 |
485 | let scm_string_ge : scm -> scm -> scm -> scm -> scm -> scm -> scm =
486 | Foreign.foreign "scm_string_ge" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
487 |
488 | let scm_string_ci_eq : scm -> scm -> scm -> scm -> scm -> scm -> scm =
489 | Foreign.foreign "scm_string_ci_eq" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
490 |
491 | let scm_string_ci_neq : scm -> scm -> scm -> scm -> scm -> scm -> scm =
492 | Foreign.foreign "scm_string_ci_neq" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
493 |
494 | let scm_string_ci_lt : scm -> scm -> scm -> scm -> scm -> scm -> scm =
495 | Foreign.foreign "scm_string_ci_lt" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
496 |
497 | let scm_string_ci_gt : scm -> scm -> scm -> scm -> scm -> scm -> scm =
498 | Foreign.foreign "scm_string_ci_gt" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
499 |
500 | let scm_string_ci_ge : scm -> scm -> scm -> scm -> scm -> scm -> scm =
501 | Foreign.foreign "scm_string_ci_ge" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
502 |
503 | let scm_string_ci_le : scm -> scm -> scm -> scm -> scm -> scm -> scm =
504 | Foreign.foreign "scm_string_ci_le" (scm @-> scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
505 |
506 | let scm_substring_hash : scm -> scm -> scm -> scm -> scm =
507 | Foreign.foreign "scm_substring_hash" (scm @-> scm @-> scm @-> scm @-> returning scm)
508 |
509 | let scm_substring_hash_ci : scm -> scm -> scm -> scm -> scm =
510 | Foreign.foreign "scm_substring_hash_ci" (scm @-> scm @-> scm @-> scm @-> returning scm)
511 |
512 | let scm_from_locale_string : string -> scm =
513 | Foreign.foreign "scm_from_locale_string" (string @-> returning scm)
514 |
515 | let scm_to_locale_stringbuf :
516 | scm -> char Ctypes_static.ptr -> Unsigned.size_t -> Unsigned.size_t =
517 | Foreign.foreign "scm_to_locale_stringbuf" (scm @-> ptr char @-> size_t @-> returning size_t)
518 |
519 | (* ==================================================================== *)
520 | (* Symbol *)
521 | (* ==================================================================== *)
522 |
523 | let scm_symbol_p : scm -> scm = Foreign.foreign "scm_symbol_p" (scm @-> returning scm)
524 |
525 | let scm_symbol_to_string : scm -> scm = Foreign.foreign "scm_symbol_to_string" (scm @-> returning scm)
526 | let scm_string_to_symbol : scm -> scm = Foreign.foreign "scm_string_to_symbol" (scm @-> returning scm)
527 |
528 | let scm_string_from_latin1_symbol : string -> scm = Foreign.foreign "scm_from_latin1_symbol" (string @-> returning scm)
529 | let scm_string_from_utf8_symbol : string -> scm = Foreign.foreign "scm_from_utf8_symbol" (string @-> returning scm)
530 |
531 | let scm_gensym: scm -> scm = Foreign.foreign "scm_gensym" (scm @-> returning scm)
532 |
533 | (* ==================================================================== *)
534 | (* Pair *)
535 | (* ==================================================================== *)
536 |
537 | let scm_is_pair : scm -> bool =
538 | Foreign.foreign "scm_is_pair" (scm @-> returning bool)
539 |
540 | let scm_cons : scm -> scm -> scm =
541 | Foreign.foreign "scm_cons" (scm @-> scm @-> returning scm)
542 |
543 | let scm_car : scm -> scm =
544 | Foreign.foreign "scm_car" (scm @-> returning scm)
545 |
546 | let scm_cdr : scm -> scm =
547 | Foreign.foreign "scm_cdr" (scm @-> returning scm)
548 |
549 | let scm_setcar : scm -> scm -> unit =
550 | Foreign.foreign "scm_setcar" (scm @-> scm @-> returning void)
551 |
552 | let scm_setcdr : scm -> scm -> unit =
553 | Foreign.foreign "scm_setcdr" (scm @-> scm @-> returning void)
554 |
555 | let scm_caar : scm -> scm =
556 | Foreign.foreign "scm_caar" (scm @-> returning scm)
557 |
558 | let scm_cadr : scm -> scm =
559 | Foreign.foreign "scm_cadr" (scm @-> returning scm)
560 |
561 | let scm_cdar : scm -> scm =
562 | Foreign.foreign "scm_cdar" (scm @-> returning scm)
563 |
564 | (* ==================================================================== *)
565 | (* List *)
566 | (* ==================================================================== *)
567 |
568 | let scm_list_p : scm -> scm = Foreign.foreign "scm_list_p" (scm @-> returning scm)
569 |
570 | let scm_null_p : scm -> scm = Foreign.foreign "scm_null_p" (scm @-> returning scm)
571 |
572 | let scm_is_null : scm -> bool = Foreign.foreign "scm_is_null_" (scm @-> returning bool)
573 |
574 | let scm_list_1 : scm -> scm = Foreign.foreign "scm_list_1" (scm @-> returning scm)
575 | let scm_list_2 : scm -> scm -> scm = Foreign.foreign "scm_list_2" (scm @-> scm @-> returning scm)
576 | let scm_list_3 : scm -> scm -> scm -> scm = Foreign.foreign "scm_list_3" (scm @-> scm @-> scm @-> returning scm)
577 | let scm_list_4 : scm -> scm -> scm -> scm -> scm = Foreign.foreign "scm_list_4" (scm @-> scm @-> scm @-> scm @-> returning scm)
578 | let scm_list_5 : scm -> scm -> scm -> scm -> scm -> scm = Foreign.foreign "scm_list_5" (scm @-> scm @-> scm @-> scm @-> scm @-> returning scm)
579 |
--------------------------------------------------------------------------------
/readme.md:
--------------------------------------------------------------------------------
1 | # Guile-OCaml
2 |
3 | Documentation available at: https://gopiandcode.github.io/guile-ocaml/
4 |
5 | Guile-ocaml is a Free Software library that provides high-level OCaml
6 | bindings to the FFI interface for GNU Guile Scheme. The aim of these
7 | bindings are to provide an easy way for OCaml developers to extend
8 | their OCaml applications with GNU Guile scheme scripting capabilities,
9 | providing simple combinators to translate terms and send queries
10 | between the two languages.
11 |
12 | ```ocaml
13 | (* initialise GNU Guile *)
14 | let () = Guile.init () in
15 | (* expose OCaml functions to Guile scheme *)
16 | let _ = Guile.Functions.register_fun1 "my-fun" ~no_opt:1
17 | (fun _ -> print_endline "hello world!"; Guile.eol) in
18 | (* start guile repl *)
19 | Guile.shell ()
20 | ```
21 |
--------------------------------------------------------------------------------
/stubgen/bindings_c_gen.ml:
--------------------------------------------------------------------------------
1 | (*
2 | GNU Guile OCaml bindings
3 |
4 | Copyright (C) 2021 Kiran Gopinathan
5 |
6 | This program is free software: you can redistribute it and/or modify
7 | it under the terms of the GNU General Public License as published by
8 | the Free Software Foundation, either version 3 of the License, or
9 | (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public License
17 | along with this program. If not, see .
18 | *)
19 |
20 | let c_headers = {|
21 | #include "libguile.h"
22 | |}
23 |
24 | let main () =
25 | let stubs_out = open_out "bindings_stubs_gen.c" in
26 | let stubs_fmt = Format.formatter_of_out_channel stubs_out in
27 | Format.fprintf stubs_fmt "%s@\n" c_headers;
28 | Cstubs.Types.write_c stubs_fmt (module Bindings.Stubs);
29 | Format.pp_print_flush stubs_fmt ();
30 | close_out stubs_out
31 |
32 | let () = main ()
33 |
--------------------------------------------------------------------------------
/stubgen/dune:
--------------------------------------------------------------------------------
1 | (executable
2 | (name bindings_c_gen)
3 | (modules bindings_c_gen)
4 | (libraries bindings ctypes.stubs ctypes))
5 |
6 | (rule
7 | (targets bindings_stubs_gen.c)
8 | (deps (:stubgen ../stubgen/bindings_c_gen.exe))
9 | (action (with-stdout-to %{targets} (run %{stubgen} -c))))
10 |
11 |
12 | (rule (targets bindings_stubs_gen.exe)
13 | (deps bindings_stubs_gen.c c_flags c_library_flags)
14 | (action
15 | (bash
16 | "%{cc} bindings_stubs_gen.c -I `dirname %{lib:ctypes:ctypes_cstubs_internals.h}` -I %{ocaml_where} $(< c_flags) $(< c_library_flags) -o %{targets}")))
17 |
18 | (rule
19 | (targets c_library_flags c_flags)
20 | (deps (:x ../config/discover.exe))
21 | (action (run %{x})))
22 |
--------------------------------------------------------------------------------