├── 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 | --------------------------------------------------------------------------------