├── .gitignore ├── CRAPL-LICENSE.txt ├── README.md ├── docs ├── index.html ├── manual-fonts.css ├── manual-racket.css ├── manual-racket.js ├── manual-style.css ├── racket.css ├── scribble-common.js ├── scribble.css ├── sorts.png ├── sorts_2.png ├── sorts_3.png └── sorts_4.png ├── examples ├── Mass_spring.svg.png ├── boolean.scrbl ├── euclid_gcd.scrbl ├── functions.scrbl ├── heron.scrbl ├── leibniz-by-example.scrbl ├── mass-on-a-spring.scrbl ├── masses.scrbl ├── mechanics.scrbl └── quantities.scrbl ├── leibniz ├── builtin-contexts.rkt ├── builtins.rkt ├── condd.rkt ├── context-syntax.rkt ├── documents.rkt ├── drracket-buttons.rkt ├── equations.rkt ├── formatting.rkt ├── images │ ├── IEEE-floating-point │ │ └── sorts.png │ ├── integers │ │ └── sorts.png │ ├── rational-numbers │ │ └── sorts.png │ ├── real-numbers │ │ └── sorts.png │ └── truth │ │ └── sorts.png ├── info.rkt ├── lang.rkt ├── lang │ └── reader.rkt ├── leibniz-button.png ├── leibniz.scrbl ├── lightweight-class.rkt ├── main.rkt ├── operators.rkt ├── parser.rkt ├── rewrite-syntax.rkt ├── rewrite.rkt ├── rule-syntax.rkt ├── run.rkt ├── signature-syntax.rkt ├── sorts.rkt ├── term-syntax.rkt ├── terms.rkt ├── test-examples.rkt ├── tools.rkt └── transformations.rkt ├── logo ├── horizontal-leibniz-logo-2500-x-1000-jpg.jpg ├── horizontal-leibniz-logo-2500-x-1000-png.png ├── horizontal-leibniz-logo-500-x-150-png.png ├── leibniz-logo-svg.svg ├── vertical-leibniz-logo-2000-x-1600-jpg.jpg └── vertical-leibniz-logo-2000-x-1600-png.png ├── notes.md └── tools ├── draw-graphs.rkt ├── draw-graphs.sh └── standalone-manual.sh /.gitignore: -------------------------------------------------------------------------------- 1 | *.rkt~ 2 | *.scrbl~ 3 | *.html 4 | *.js 5 | *.css 6 | *.xml 7 | *.sig 8 | compiled/ 9 | graphs/ 10 | attic/ 11 | leibniz/doc 12 | test.rkt 13 | .projectile 14 | -------------------------------------------------------------------------------- /CRAPL-LICENSE.txt: -------------------------------------------------------------------------------- 1 | THE CRAPL v0 BETA 1 2 | 3 | 4 | 0. Information about the CRAPL 5 | 6 | If you have questions or concerns about the CRAPL, or you need more 7 | information about this license, please contact: 8 | 9 | Matthew Might 10 | http://matt.might.net/ 11 | 12 | 13 | I. Preamble 14 | 15 | Science thrives on openness. 16 | 17 | In modern science, it is often infeasible to replicate claims without 18 | access to the software underlying those claims. 19 | 20 | Let's all be honest: when scientists write code, aesthetics and 21 | software engineering principles take a back seat to having running, 22 | working code before a deadline. 23 | 24 | So, let's release the ugly. And, let's be proud of that. 25 | 26 | 27 | II. Definitions 28 | 29 | 1. "This License" refers to version 0 beta 1 of the Community 30 | Research and Academic Programming License (the CRAPL). 31 | 32 | 2. "The Program" refers to the medley of source code, shell scripts, 33 | executables, objects, libraries and build files supplied to You, 34 | or these files as modified by You. 35 | 36 | [Any appearance of design in the Program is purely coincidental and 37 | should not in any way be mistaken for evidence of thoughtful 38 | software construction.] 39 | 40 | 3. "You" refers to the person or persons brave and daft enough to use 41 | the Program. 42 | 43 | 4. "The Documentation" refers to the Program. 44 | 45 | 5. "The Author" probably refers to the caffeine-addled graduate 46 | student that got the Program to work moments before a submission 47 | deadline. 48 | 49 | 50 | III. Terms 51 | 52 | 1. By reading this sentence, You have agreed to the terms and 53 | conditions of this License. 54 | 55 | 2. If the Program shows any evidence of having been properly tested 56 | or verified, You will disregard this evidence. 57 | 58 | 3. You agree to hold the Author free from shame, embarrassment or 59 | ridicule for any hacks, kludges or leaps of faith found within the 60 | Program. 61 | 62 | 4. You recognize that any request for support for the Program will be 63 | discarded with extreme prejudice. 64 | 65 | 5. The Author reserves all rights to the Program, except for any 66 | rights granted under any additional licenses attached to the 67 | Program. 68 | 69 | 70 | IV. Permissions 71 | 72 | 1. You are permitted to use the Program to validate published 73 | scientific claims. 74 | 75 | 2. You are permitted to use the Program to validate scientific claims 76 | submitted for peer review, under the condition that You keep 77 | modifications to the Program confidential until those claims have 78 | been published. 79 | 80 | 3. You are permitted to use and/or modify the Program for the 81 | validation of novel scientific claims if You make a good-faith 82 | attempt to notify the Author of Your work and Your claims prior to 83 | submission for publication. 84 | 85 | 4. If You publicly release any claims or data that were supported or 86 | generated by the Program or a modification thereof, in whole or in 87 | part, You will release any inputs supplied to the Program and any 88 | modifications You made to the Progam. This License will be in 89 | effect for the modified program. 90 | 91 | 92 | V. Disclaimer of Warranty 93 | 94 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 95 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 96 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT 97 | WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT 98 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 99 | A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND 100 | PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE 101 | DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR 102 | CORRECTION. 103 | 104 | 105 | VI. Limitation of Liability 106 | 107 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 108 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR 109 | CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 110 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES 111 | ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT 112 | NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR 113 | LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM 114 | TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER 115 | PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 116 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | ![](https://github.com/khinsen/leibniz/raw/master/logo/horizontal-leibniz-logo-500-x-150-png.png) 3 | 4 | # Foreword 5 | 6 | This repository and its companion 7 | [leibniz-examples](https://github.com/khinsen/leibniz-examples) 8 | contain the first iteration of the Leibniz research project. It 9 | focused on designing a Digital Scientific Notation suitable for 10 | embedding into narratives such as scientific publications or 11 | university-level textbooks. Work has shifted to the [second 12 | iteration](https://github.com/khinsen/leibniz-pharo), which focuses on 13 | interactive authoring of documents embedding Leibniz and integrating 14 | them with interactive explorative computations. It is documented on 15 | [its own Web site](https://leibniz.khinsen.net/). 16 | 17 | The following text is the original README from the last activity on 18 | the first iteration, around 2020, except for a few links that have 19 | been updated, following a reorganization of my Web site. 20 | 21 | # A digital scientific notation 22 | 23 | Leibniz is an attempt to define a digital scientific notation, i.e. a 24 | formal language for writing down scientific models in terms of 25 | equations and algorithms. Such models can be published, cited, and 26 | discussed, in addition to being manipulated by software. 27 | 28 | The best way to get an impression of what Leibniz is and what 29 | you can do with it is to read the one-page introduction 30 | ["Leibniz by example"](https://leibniz.khinsen.net/leibniz1/examples/leibniz-by-example.html). 31 | Then you can move on to the [other examples](https://leibniz.khinsen.net/leibniz1/examples/index.html) 32 | and to [the manual](https://leibniz.khinsen.net/leibniz1/manual/index.html). You can also watch 33 | my [presentation at RacketCon 2020](https://youtu.be/YbznItQpALo?t=2104). 34 | 35 | Readers interested in the studying the implementation (which needs 36 | a serious cleanup) should start by looking at the file `notes.md` for 37 | an overview of the code structure. 38 | 39 | Leibniz is named after 40 | [Gottfried Wilhelm Leibniz](https://en.wikipedia.org/wiki/Gottfried_Wilhelm_Leibniz), 41 | who made important contributions to science, mathematics, formal 42 | logic, and computation, topics that are all relevant to this project. 43 | He invented a widely used [notation for calculus](https://en.wikipedia.org/wiki/Leibniz%27s_notation), 44 | laid the foundation of equational logic by his [definition of equality](https://en.wikipedia.org/wiki/Equality_(mathematics)), 45 | and anticipated formal logic with his ["calculus ratiocinator"](https://en.wikipedia.org/wiki/Calculus_ratiocinator). 46 | 47 | ## Status 48 | 49 | In a word: experimental. The major milestone that the implementation has 50 | reached is to play its role of a digital scientific notation: Leibniz specifications 51 | are embedded into the plain text discourse written for human readers, just 52 | like traditional semi-formal mathematical notation. This matters because 53 | it eliminates an important source of mistakes: the translation from human-readable 54 | and peer-reviewed descriptions of models and methods into computer-readable code. 55 | 56 | However, many features that I have planned for the language are still missing: built-in 57 | collection types (lists/arrays, sets, ...) interfaces to databases and external datasets, 58 | support for workflows. Although in principle today's Leibniz can be used for everything 59 | (given that it's Turing-complete), it is still insufficient to express many 60 | aspects of computational science in a sufficiently concise and convenient form. 61 | 62 | The master branch of this repository contains the version of Leibniz that has been described in the article [Verifiability in computer-aided research: the role of digital scientific notations at the human-computer interface](https://peerj.com/articles/cs-158/). Since then, I have been working on a major redesign on the branch [pollen](https://github.com/khinsen/leibniz/tree/pollen). As its name suggests, it uses the [Pollen](https://docs.racket-lang.org/pollen/) library rather than [Scribble](https://docs.racket-lang.org/scribble/index.html) documentation system that the master branch builds on. The main reason is finer control over the generated HTML files, with in particular the embedding of the machine-readable XML code into the human-readable HTML file. A Leibniz document is thus now a single file that can be identified by a single URL or a single hash code. 63 | 64 | A [second implementation](https://github.com/khinsen/leibniz-pharo/) of Leibniz, incomplete so far, builds on the live object programming system [Pharo](http://pharo.org/), a descendant of Smalltalk. The main reason for this development is the explore the possibilities for authoring and exploring models formulated in Leibniz interactively. Pharo serves both as an implementation substrate (I expect to be able to extend or re-use the Pharo software development tools for Leibnis) and as a source of inspiration, given the long tradition in the Smalltalk community of eliminating the developer-user dichotomy that is, in my opinion, a major obstacle in computational science. 65 | 66 | ## Required software, installation 67 | 68 | This first implementation of Leibniz is written in 69 | [Racket](http://racket-lang.org/), whose support for implementing 70 | languages and language extensions is particularly useful for this 71 | project. In addition to Racket itself, Leibniz depends on the 72 | following libraries: 73 | 74 | - [megaparsack](https://github.com/lexi-lambda/megaparsack) 75 | - [threading](https://github.com/lexi-lambda/threading) 76 | - [sxml](https://github.com/jbclements/sxml/tree/master) 77 | - [chk](https://github.com/jeapostrophe/chk) 78 | 79 | To install Leibniz and its dependencies, first install the Racket system 80 | on your computer, and then type, in a terminal window: 81 | ```bash 82 | raco pkg install git://github.com/khinsen/leibniz\?path=leibniz 83 | ``` 84 | 85 | To run the Leibniz test suite, type 86 | ```bash 87 | raco test -c leibniz 88 | ``` 89 | 90 | You can then use Leibniz in two ways: 91 | 92 | - In Racket's IDE, called DrRacket. Any file starting with 93 | ``` 94 | #lang leibniz 95 | ``` 96 | is treated as a Leibniz document. Clicking on the Leibniz button 97 | creates a human-readable HTML version and a machine-readable XML 98 | version of the document, and opens the HTML file immediately in 99 | a browser for inspection. 100 | 101 | - Write your Leibniz documents using any text editor, and generate 102 | the HTML/XML files using the `leibniz` command line utility. It 103 | is part of installation process, but the location where it ends up 104 | is very platform-dependent. The good news is that the precise location 105 | is indicated near the end of the installation process, so have a 106 | careful look at the log output of `raco pkg install ...`. 107 | 108 | For more information, see the [Leibniz manual](http://khinsen.net/leibniz/): 109 | 110 | - In DrRacket, go to the "Help" menu and select "Racket 111 | Documentation". This will open the table of contents of the Racket 112 | documentation in a browser. Search for "Leibniz" and click the link. 113 | 114 | - From a terminal command line, run "raco docs leibniz" 115 | 116 | ## License 117 | 118 | I expect to properly document and release this code at some time, 119 | under a meaningful license. But for now, it is research code covered 120 | by the [CRAPL](http://matt.might.net/articles/crapl/) license. 121 | 122 | ## Background 123 | 124 | The following articles are helpful to understand the context in which 125 | Leibniz is developed: 126 | 127 | - My essay 128 | [Scientific notations for the digital era](http://sjscience.org/article?id=527) 129 | explains the concept of digital scientific notations, in particular 130 | as opposed to scientific software. 131 | 132 | - Mark Buchanan wrote an excellent one-page summary of this essay for 133 | [Nature Physics](http://www.nature.com/nphys/index.html), under the 134 | title 135 | [Digital Science](http://www.nature.com/doifinder/10.1038/nphys3815). 136 | 137 | - My article [Verifiability in computer-aided research: the role of digital scientific notations at the human-computer interface](https://peerj.com/articles/cs-158/) reports on the research that has lead to the development of Leibniz. 138 | 139 | - I have written two short essays on related topics: 140 | [Scientific communication in the digital age](http://dx.doi.org/10.1063/PT.3.3181) 141 | and 142 | [Verifiable research: The missing link between replicability and reproducibility](http://dx.doi.org/10.15200/winn.146857.76572) 143 | 144 | Leibniz is based on 145 | [equational logic](https://en.wikipedia.org/wiki/Equational_logic) and 146 | [term rewriting](https://en.wikipedia.org/wiki/Rewriting#Term_rewriting_systems). 147 | This seems an appropriate choice for scientific models that are 148 | traditionally written as mathematical equations. Algorithms are 149 | expressed by giving a direction to certain equations, indicating that 150 | the left-hand side is supposed to be replaced by the right-hand side 151 | in simplifying an expression. Term rewriting has been used for a long 152 | time in computer algebra, notably by 153 | [Mathematica](https://www.wolfram.com/mathematica/). 154 | 155 | Leibniz differs from Mathematica and most other computer algebra 156 | systems in using an order-sorted term algebra, in which each term is 157 | assigned a **sort**, which is similar to what is called a **type** in 158 | programming languages. For a detailed discussion of order-sorted 159 | algebra, see 160 | 161 | - [Order-sorted algebra I: Equational deduction for multiple inheritance, overloading, exceptions and partial operations](http://dx.doi.org/10.1016/0304-3975(92)90302-V) by J. A. Goguen and J. Meseguer 162 | 163 | Term rewriting in order-sorted algebras has been implemented in the 164 | specification languages 165 | [OBJ](http://cseweb.ucsd.edu/~goguen/sys/obj.html) and its modern 166 | offshoot [Maude](http://maude.cs.illinois.edu/). For readers familiar 167 | with these languages, a Leibniz "context" is roughly the same as an "object" 168 | in OBJ or a 169 | "[functional module](http://maude.cs.uiuc.edu/maude2-manual/html/maude-manualch4.html)" 170 | in Maude. Reading the Maude documentation is currently the best 171 | preparation for understanding Leibniz. 172 | 173 | However, Leibniz is much simpler than Maude, lacking both Maude's 174 | flexible syntax and its support for non-functional modules. This is 175 | due to a very different focus: Maude is a language for writing 176 | specifications for complex software, whereas Leibniz is a notation for 177 | scientific models. Scientific models are much simpler than most 178 | software, but they can be processed by a wide range of 179 | software. Leibniz must therefore be easy to implement in a wide range 180 | of software packages, whereas reimplementing Maude is of little 181 | interest, given that its source code is open. 182 | 183 | ## Branch notes 184 | 185 | Most branches of this repository contain experiments that test the 186 | utility and feasibility of ideas for improvements and new 187 | features. Each branch has a short note in this place that explains its 188 | reason for being. 189 | 190 | Note that all branches except master may be rebased, or modified in 191 | other ways. If you want to fork this repository, please don't rely on 192 | any branch other than master. 193 | 194 | This branch replaces Scribble by Pollen as the underlying document 195 | processing platform. The advantage of using Pollen is that all processing 196 | can be done at the xexpr level. This means in particular that the 197 | messy macro system for defining contexts can be replaced by much 198 | simpler plain functions. Another advantage is that Pollen allows precise 199 | control over the HTML output, which makes it possible to embed the XML 200 | representation as a script in the HTML file. 201 | -------------------------------------------------------------------------------- /docs/manual-racket.css: -------------------------------------------------------------------------------- 1 | /* See the beginning of "manual.css". */ 2 | 3 | /* Monospace: */ 4 | 5 | .RktIn, .RktRdr, .RktPn, .RktMeta, 6 | .RktMod, .RktKw, .RktVar, .RktSym, 7 | .RktRes, .RktOut, .RktCmt, .RktVal, 8 | .RktBlk, .RktErr { 9 | font-family: 'Source Code Pro', monospace; 10 | white-space: inherit; 11 | font-size: 1rem; 12 | } 13 | 14 | /* this selctor grabs the first linked Racket symbol 15 | in a definition box (i.e., the symbol being defined) */ 16 | a.RktValDef, a.RktStxDef, a.RktSymDef, 17 | span.RktValDef, span.RktStxDef, span.RktSymDef 18 | { 19 | font-size: 1.15rem; 20 | color: black; 21 | font-weight: 600; 22 | } 23 | 24 | 25 | .inheritedlbl { 26 | font-family: 'Fira', sans; 27 | } 28 | 29 | .RBackgroundLabelInner { 30 | font-family: inherit; 31 | } 32 | 33 | /* ---------------------------------------- */ 34 | /* Inherited methods, left margin */ 35 | 36 | .inherited { 37 | width: 95%; 38 | margin-top: 0.5em; 39 | text-align: left; 40 | background-color: inherit; 41 | } 42 | 43 | .inherited td { 44 | font-size: 82%; 45 | padding-left: 0.5rem; 46 | line-height: 1.3; 47 | text-indent: 0; 48 | padding-right: 0; 49 | } 50 | 51 | .inheritedlbl { 52 | font-style: normal; 53 | } 54 | 55 | /* ---------------------------------------- */ 56 | /* Racket text styles */ 57 | 58 | .RktIn { 59 | color: #cc6633; 60 | background-color: #eee; 61 | } 62 | 63 | .RktInBG { 64 | background-color: #eee; 65 | } 66 | 67 | 68 | .refcolumn .RktInBG { 69 | background-color: white; 70 | } 71 | 72 | .RktRdr { 73 | } 74 | 75 | .RktPn { 76 | color: #843c24; 77 | } 78 | 79 | .RktMeta { 80 | color: black; 81 | } 82 | 83 | .RktMod { 84 | color: inherit; 85 | } 86 | 87 | .RktOpt { 88 | color: black; 89 | } 90 | 91 | .RktKw { 92 | color: black; 93 | } 94 | 95 | .RktErr { 96 | color: red; 97 | font-style: italic; 98 | font-weight: 400; 99 | } 100 | 101 | .RktVar { 102 | position: relative; 103 | left: -1px; font-style: italic; 104 | color: #444; 105 | } 106 | 107 | .SVInsetFlow .RktVar { 108 | font-weight: 400; 109 | color: #444; 110 | } 111 | 112 | 113 | .RktSym { 114 | color: inherit; 115 | } 116 | 117 | 118 | 119 | .RktValLink, .RktStxLink, .RktModLink { 120 | text-decoration: none; 121 | color: #07A; 122 | font-weight: 500; 123 | font-size: 1rem; 124 | } 125 | 126 | /* for syntax links within headings */ 127 | h2 a.RktStxLink, h3 a.RktStxLink, h4 a.RktStxLink, h5 a.RktStxLink, 128 | h2 a.RktValLink, h3 a.RktValLink, h4 a.RktValLink, h5 a.RktValLink, 129 | h2 .RktSym, h3 .RktSym, h4 .RktSym, h5 .RktSym, 130 | h2 .RktMod, h3 .RktMod, h4 .RktMod, h5 .RktMod, 131 | h2 .RktVal, h3 .RktVal, h4 .RktVal, h5 .RktVal, 132 | h2 .RktPn, h3 .RktPn, h4 .RktPn, h5 .RktPn { 133 | color: #333; 134 | font-size: 1.65rem; 135 | font-weight: 400; 136 | } 137 | 138 | .toptoclink .RktStxLink, .toclink .RktStxLink, 139 | .toptoclink .RktValLink, .toclink .RktValLink, 140 | .toptoclink .RktModLink, .toclink .RktModLink { 141 | color: inherit; 142 | } 143 | 144 | .tocset .RktValLink, .tocset .RktStxLink, .tocset .RktModLink { 145 | color: black; 146 | font-weight: 400; 147 | font-size: 0.9rem; 148 | } 149 | 150 | .tocset td a.tocviewselflink .RktValLink, 151 | .tocset td a.tocviewselflink .RktStxLink, 152 | .tocset td a.tocviewselflink .RktMod, 153 | .tocset td a.tocviewselflink .RktSym { 154 | font-weight: lighter; 155 | color: white; 156 | } 157 | 158 | 159 | .RktRes { 160 | color: #0000af; 161 | } 162 | 163 | .RktOut { 164 | color: #960096; 165 | } 166 | 167 | .RktCmt { 168 | color: #c2741f; 169 | } 170 | 171 | .RktVal { 172 | color: #228b22; 173 | } 174 | 175 | /* ---------------------------------------- */ 176 | /* Some inline styles */ 177 | 178 | .together { /* for definitions grouped together in one box */ 179 | width: 100%; 180 | border-top: 2px solid white; 181 | } 182 | 183 | tbody > tr:first-child > td > .together { 184 | border-top: 0px; /* erase border on first instance of together */ 185 | } 186 | 187 | .RktBlk { 188 | white-space: pre; 189 | text-align: left; 190 | } 191 | 192 | .highlighted { 193 | font-size: 1rem; 194 | background-color: #fee; 195 | } 196 | 197 | .defmodule { 198 | font-family: 'Source Code Pro'; 199 | padding: 0.25rem 0.75rem 0.25rem 0.5rem; 200 | margin-bottom: 1rem; 201 | width: 100%; 202 | background-color: hsl(60, 29%, 94%); 203 | } 204 | 205 | .defmodule a { 206 | color: #444; 207 | } 208 | 209 | 210 | .defmodule td span.hspace:first-child { 211 | position: absolute; 212 | width: 0; 213 | display: inline-block; 214 | } 215 | 216 | .defmodule .RpackageSpec .Smaller, 217 | .defmodule .RpackageSpec .stt { 218 | font-size: 1rem; 219 | } 220 | 221 | 222 | .specgrammar { 223 | float: none; 224 | padding-left: 1em; 225 | } 226 | 227 | 228 | .RBibliography td { 229 | vertical-align: text-top; 230 | padding-top: 1em; 231 | } 232 | 233 | .leftindent { 234 | margin-left: 2rem; 235 | margin-right: 0em; 236 | } 237 | 238 | .insetpara { 239 | margin-left: 1em; 240 | margin-right: 1em; 241 | } 242 | 243 | .SCodeFlow .Rfilebox { 244 | margin-left: -1em; /* see 17.2 of guide, module languages */ 245 | } 246 | 247 | .Rfiletitle { 248 | text-align: right; 249 | background-color: #eee; 250 | } 251 | 252 | .SCodeFlow .Rfiletitle { 253 | border-top: 1px dotted gray; 254 | border-right: 1px dotted gray; 255 | } 256 | 257 | 258 | .Rfilename { 259 | border-top: 0; 260 | border-right: 0; 261 | padding-left: 0.5em; 262 | padding-right: 0.5em; 263 | background-color: inherit; 264 | } 265 | 266 | .Rfilecontent { 267 | margin: 0.5em; 268 | } 269 | 270 | .RpackageSpec { 271 | padding-right: 0; 272 | } 273 | 274 | /* ---------------------------------------- */ 275 | /* For background labels */ 276 | 277 | .RBackgroundLabel { 278 | float: right; 279 | width: 0px; 280 | height: 0px; 281 | } 282 | 283 | .RBackgroundLabelInner { 284 | position: relative; 285 | width: 25em; 286 | left: -25.5em; 287 | top: 0.20rem; /* sensitive to monospaced font choice */ 288 | text-align: right; 289 | z-index: 0; 290 | font-weight: 300; 291 | font-family: 'Source Code Pro'; 292 | font-size: 0.9rem; 293 | color: gray; 294 | } 295 | 296 | 297 | .RpackageSpec .Smaller { 298 | font-weight: 300; 299 | font-family: 'Source Code Pro'; 300 | font-size: 0.9rem; 301 | } 302 | 303 | .RForeground { 304 | position: relative; 305 | left: 0px; 306 | top: 0px; 307 | z-index: 1; 308 | } 309 | 310 | /* ---------------------------------------- */ 311 | /* For section source modules & tags */ 312 | 313 | .RPartExplain { 314 | background: #eee; 315 | font-size: 0.9rem; 316 | margin-top: 0.2rem; 317 | padding: 0.2rem; 318 | text-align: left; 319 | } 320 | -------------------------------------------------------------------------------- /docs/manual-racket.js: -------------------------------------------------------------------------------- 1 | /* For the Racket manual style */ 2 | 3 | AddOnLoad(function() { 4 | /* Look for header elements that have x-source-module and x-part tag. 5 | For those elements, add a hidden element that explains how to 6 | link to the section, and set the element's onclick() to display 7 | the explanation. */ 8 | var tag_names = ["h1", "h2", "h3", "h4", "h5"]; 9 | for (var j = 0; j < tag_names.length; j++) { 10 | elems = document.getElementsByTagName(tag_names[j]); 11 | for (var i = 0; i < elems.length; i++) { 12 | var elem = elems.item(i); 13 | AddPartTitleOnClick(elem); 14 | } 15 | } 16 | }) 17 | 18 | function AddPartTitleOnClick(elem) { 19 | var mod_path = elem.getAttribute("x-source-module"); 20 | var tag = elem.getAttribute("x-part-tag"); 21 | if (mod_path && tag) { 22 | // Might not be present: 23 | var prefixes = elem.getAttribute("x-part-prefixes"); 24 | 25 | var info = document.createElement("div"); 26 | info.className = "RPartExplain"; 27 | 28 | /* The "top" tag refers to a whole document: */ 29 | var is_top = (tag == "\"top\""); 30 | info.appendChild(document.createTextNode("Link to this " 31 | + (is_top ? "document" : "section") 32 | + " with ")); 33 | 34 | /* Break `secref` into two lines if the module path and tag 35 | are long enough: */ 36 | var is_long = (is_top ? false : ((mod_path.length 37 | + tag.length 38 | + (prefixes ? (16 + prefixes.length) : 0)) 39 | > 60)); 40 | 41 | var line1 = document.createElement("div"); 42 | var line1x = ((is_long && prefixes) ? document.createElement("div") : line1); 43 | var line2 = (is_long ? document.createElement("div") : line1); 44 | 45 | function add(dest, str, cn) { 46 | var s = document.createElement("span"); 47 | s.className = cn; 48 | s.style.whiteSpace = "nowrap"; 49 | s.appendChild(document.createTextNode(str)); 50 | dest.appendChild(s); 51 | } 52 | /* Construct a `secref` call with suitable syntax coloring: */ 53 | add(line1, "\xA0@", "RktRdr"); 54 | add(line1, (is_top ? "other-doc" : "secref"), "RktSym"); 55 | add(line1, "[", "RktPn"); 56 | if (!is_top) 57 | add(line1, tag, "RktVal"); 58 | if (is_long) { 59 | /* indent additional lines: */ 60 | if (prefixes) 61 | add(line1x, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn"); 62 | add(line2, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn"); 63 | } 64 | if (prefixes) { 65 | add(line1x, " #:tag-prefixes ", "RktPn"); 66 | add(line1x, "'", "RktVal"); 67 | add(line1x, prefixes, "RktVal"); 68 | } 69 | if (!is_top) 70 | add(line2, " #:doc ", "RktPn"); 71 | add(line2, "'", "RktVal"); 72 | add(line2, mod_path, "RktVal"); 73 | add(line2, "]", "RktPn"); 74 | 75 | info.appendChild(line1); 76 | if (is_long) 77 | info.appendChild(line1x); 78 | if (is_long) 79 | info.appendChild(line2); 80 | 81 | info.style.display = "none"; 82 | 83 | /* Add the new element afterthe header: */ 84 | var n = elem.nextSibling; 85 | if (n) 86 | elem.parentNode.insertBefore(info, n); 87 | else 88 | elem.parentNode.appendChild(info); 89 | 90 | /* Clicking the header shows the explanation element: */ 91 | elem.onclick = function () { 92 | if (info.style.display == "none") 93 | info.style.display = "block"; 94 | else 95 | info.style.display = "none"; 96 | } 97 | } 98 | } 99 | -------------------------------------------------------------------------------- /docs/manual-style.css: -------------------------------------------------------------------------------- 1 | 2 | /* See the beginning of "scribble.css". 3 | This file is used by the `scribble/manual` language, along with 4 | "manual-racket.css". */ 5 | 6 | @import url("manual-fonts.css"); 7 | 8 | * { 9 | margin: 0; 10 | padding: 0; 11 | } 12 | 13 | @media all {html {font-size: 15px;}} 14 | @media all and (max-width:940px){html {font-size: 14px;}} 15 | @media all and (max-width:850px){html {font-size: 13px;}} 16 | @media all and (max-width:830px){html {font-size: 12px;}} 17 | @media all and (max-width:740px){html {font-size: 11px;}} 18 | 19 | /* CSS seems backward: List all the classes for which we want a 20 | particular font, so that the font can be changed in one place. (It 21 | would be nicer to reference a font definition from all the places 22 | that we want it.) 23 | 24 | As you read the rest of the file, remember to double-check here to 25 | see if any font is set. */ 26 | 27 | /* Monospace: */ 28 | .maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft { 29 | font-family: 'Source Code Pro', monospace; 30 | white-space: inherit; 31 | font-size: 1rem; 32 | } 33 | 34 | .stt { 35 | font-weight: 500; 36 | } 37 | 38 | h2 .stt { 39 | font-size: 2.7rem; 40 | } 41 | 42 | .toptoclink .stt { 43 | font-size: inherit; 44 | } 45 | .toclink .stt { 46 | font-size: 90%; 47 | } 48 | 49 | .RpackageSpec .stt { 50 | font-weight: 300; 51 | font-family: 'Source Code Pro'; 52 | font-size: 0.9rem; 53 | } 54 | 55 | h3 .stt, h4 .stt, h5 .stt { 56 | color: #333; 57 | font-size: 1.65rem; 58 | font-weight: 400; 59 | } 60 | 61 | 62 | /* Serif: */ 63 | .main, .refcontent, .tocview, .tocsub, .sroman, i { 64 | font-family: 'Charter', serif; 65 | font-size: 1.18rem; 66 | } 67 | 68 | 69 | /* Sans-serif: */ 70 | .version, .versionNoNav, .ssansserif { 71 | font-family: 'Fira', sans-serif; 72 | } 73 | .ssansserif { 74 | font-family: 'Fira'; 75 | font-weight: 500; 76 | font-size: 0.9em; 77 | } 78 | 79 | .tocset .ssansserif { 80 | font-size: 100%; 81 | } 82 | 83 | /* ---------------------------------------- */ 84 | 85 | p, .SIntrapara { 86 | display: block; 87 | margin: 0 0 1em 0; 88 | line-height: 1.4; 89 | } 90 | 91 | .compact { 92 | padding: 0 0 1em 0; 93 | } 94 | 95 | li { 96 | list-style-position: outside; 97 | margin-left: 1.2em; 98 | } 99 | 100 | h1, h2, h3, h4, h5, h6, h7, h8 { 101 | font-family: 'Fira'; 102 | font-weight: 300; 103 | font-size: 1.6rem; 104 | color: #333; 105 | margin-top: inherit; 106 | margin-bottom: 1rem; 107 | line-height: 1.25; 108 | -moz-font-feature-settings: 'tnum=1'; 109 | -moz-font-feature-settings: 'tnum' 1; 110 | -webkit-font-feature-settings: 'tnum' 1; 111 | -o-font-feature-settings: 'tnum' 1; 112 | -ms-font-feature-settings: 'tnum' 1; 113 | font-feature-settings: 'tnum' 1; 114 | 115 | } 116 | 117 | h3, h4, h5, h6, h7, h8 { 118 | border-top: 1px solid black; 119 | } 120 | 121 | 122 | 123 | h2 { /* per-page main title */ 124 | font-family: 'Miso'; 125 | font-weight: bold; 126 | margin-top: 4rem; 127 | font-size: 3rem; 128 | line-height: 1.1; 129 | width: 90%; 130 | } 131 | 132 | h3, h4, h5, h6, h7, h8 { 133 | margin-top: 2em; 134 | padding-top: 0.1em; 135 | margin-bottom: 0.75em; 136 | } 137 | 138 | /* ---------------------------------------- */ 139 | /* Main */ 140 | 141 | body { 142 | color: black; 143 | background-color: white; 144 | } 145 | 146 | .maincolumn { 147 | width: auto; 148 | margin-top: 4rem; 149 | margin-left: 17rem; 150 | margin-right: 2rem; 151 | margin-bottom: 10rem; /* to avoid fixed bottom nav bar */ 152 | max-width: 700px; 153 | min-width: 370px; /* below this size, code samples don't fit */ 154 | } 155 | 156 | a { 157 | text-decoration: inherit; 158 | } 159 | 160 | a, .toclink, .toptoclink, .tocviewlink, .tocviewselflink, .tocviewtoggle, .plainlink, 161 | .techinside, .techoutside:hover, .techinside:hover { 162 | color: #07A; 163 | } 164 | 165 | a:hover { 166 | text-decoration: underline; 167 | } 168 | 169 | 170 | /* ---------------------------------------- */ 171 | /* Navigation */ 172 | 173 | .navsettop, .navsetbottom { 174 | left: 0; 175 | width: 15rem; 176 | height: 6rem; 177 | font-family: 'Fira'; 178 | font-size: 0.9rem; 179 | border-bottom: 0px solid hsl(216, 15%, 70%); 180 | background-color: inherit; 181 | padding: 0; 182 | } 183 | 184 | .navsettop { 185 | position: absolute; 186 | top: 0; 187 | left: 0; 188 | margin-bottom: 0; 189 | border-bottom: 0; 190 | } 191 | 192 | .navsettop a, .navsetbottom a { 193 | color: black; 194 | } 195 | 196 | .navsettop a:hover, .navsetbottom a:hover { 197 | background: hsl(216, 78%, 95%); 198 | text-decoration: none; 199 | } 200 | 201 | .navleft, .navright { 202 | position: static; 203 | float: none; 204 | margin: 0; 205 | white-space: normal; 206 | } 207 | 208 | 209 | .navleft a { 210 | display: inline-block; 211 | } 212 | 213 | .navright a { 214 | display: inline-block; 215 | text-align: center; 216 | } 217 | 218 | .navleft a, .navright a, .navright span { 219 | display: inline-block; 220 | padding: 0.5rem; 221 | min-width: 1rem; 222 | } 223 | 224 | 225 | .navright { 226 | height: 2rem; 227 | white-space: nowrap; 228 | } 229 | 230 | 231 | .navsetbottom { 232 | display: none; 233 | } 234 | 235 | .nonavigation { 236 | color: #889; 237 | } 238 | 239 | .searchform { 240 | display: block; 241 | margin: 0; 242 | padding: 0; 243 | border-bottom: 1px solid #eee; 244 | height: 4rem; 245 | } 246 | 247 | .nosearchform { 248 | margin: 0; 249 | padding: 0; 250 | height: 4rem; 251 | } 252 | 253 | .searchbox { 254 | font-size: 1rem; 255 | width: 12rem; 256 | margin: 1rem; 257 | padding: 0.25rem; 258 | vertical-align: middle; 259 | background-color: white; 260 | } 261 | 262 | #search_box { 263 | font-size: 0.8rem; 264 | } 265 | 266 | /* ---------------------------------------- */ 267 | /* Version */ 268 | 269 | .versionbox { 270 | position: absolute; 271 | float: none; 272 | top: 0.25rem; 273 | left: 17rem; 274 | z-index: 11000; 275 | height: 2em; 276 | font-size: 70%; 277 | font-weight: lighter; 278 | width: inherit; 279 | margin: 0; 280 | } 281 | .version, .versionNoNav { 282 | font-size: inherit; 283 | } 284 | .version:before, .versionNoNav:before { 285 | content: "v."; 286 | } 287 | 288 | 289 | /* ---------------------------------------- */ 290 | /* Margin notes */ 291 | 292 | /* cancel scribble.css styles: */ 293 | .refpara, .refelem { 294 | position: static; 295 | float: none; 296 | height: auto; 297 | width: auto; 298 | margin: 0; 299 | } 300 | 301 | .refcolumn { 302 | position: static; 303 | display: block; 304 | width: auto; 305 | font-size: inherit; 306 | margin: 2rem; 307 | margin-left: 2rem; 308 | padding: 0.5em; 309 | padding-left: 0.75em; 310 | padding-right: 1em; 311 | background: hsl(60, 29%, 94%); 312 | border: 1px solid #ccb; 313 | border-left: 0.4rem solid #ccb; 314 | } 315 | 316 | 317 | /* slightly different handling for margin-note* on narrow screens */ 318 | @media all and (max-width:1340px) { 319 | span.refcolumn { 320 | float: right; 321 | width: 50%; 322 | margin-left: 1rem; 323 | margin-bottom: 0.8rem; 324 | margin-top: 1.2rem; 325 | } 326 | 327 | } 328 | 329 | .refcontent, .refcontent p { 330 | line-height: 1.5; 331 | margin: 0; 332 | } 333 | 334 | .refcontent p + p { 335 | margin-top: 1em; 336 | } 337 | 338 | .refcontent a { 339 | font-weight: 400; 340 | } 341 | 342 | .refpara, .refparaleft { 343 | top: -1em; 344 | } 345 | 346 | 347 | @media all and (max-width:600px) { 348 | .refcolumn { 349 | margin-left: 0; 350 | margin-right: 0; 351 | } 352 | } 353 | 354 | 355 | @media all and (min-width:1340px) { 356 | .refcolumn { 357 | margin: 0 -22.5rem 1rem 0; 358 | float: right; 359 | clear: right; 360 | width: 18rem; 361 | } 362 | } 363 | 364 | .refcontent { 365 | font-family: 'Fira'; 366 | font-size: 1rem; 367 | line-height: 1.6; 368 | margin: 0 0 0 0; 369 | } 370 | 371 | 372 | .refparaleft, .refelemleft { 373 | position: relative; 374 | float: left; 375 | right: 2em; 376 | height: 0em; 377 | width: 13em; 378 | margin: 0em 0em 0em -13em; 379 | } 380 | 381 | .refcolumnleft { 382 | background-color: hsl(60, 29%, 94%); 383 | display: block; 384 | position: relative; 385 | width: 13em; 386 | font-size: 85%; 387 | border: 0.5em solid hsl(60, 29%, 94%); 388 | margin: 0 0 0 0; 389 | } 390 | 391 | 392 | /* ---------------------------------------- */ 393 | /* Table of contents, left margin */ 394 | 395 | .tocset { 396 | position: absolute; 397 | float: none; 398 | left: 0; 399 | top: 0rem; 400 | width: 14rem; 401 | padding: 7rem 0.5rem 0.5rem 0.5rem; 402 | background-color: hsl(216, 15%, 70%); 403 | margin: 0; 404 | 405 | } 406 | 407 | .tocset td { 408 | vertical-align: text-top; 409 | padding-bottom: 0.4rem; 410 | padding-left: 0.2rem; 411 | line-height: 1.1; 412 | font-family: 'Fira'; 413 | -moz-font-feature-settings: 'tnum=1'; 414 | -moz-font-feature-settings: 'tnum' 1; 415 | -webkit-font-feature-settings: 'tnum' 1; 416 | -o-font-feature-settings: 'tnum' 1; 417 | -ms-font-feature-settings: 'tnum' 1; 418 | font-feature-settings: 'tnum' 1; 419 | 420 | } 421 | 422 | .tocset td a { 423 | color: black; 424 | font-weight: 400; 425 | } 426 | 427 | 428 | .tocview { 429 | text-align: left; 430 | background-color: inherit; 431 | } 432 | 433 | 434 | .tocview td, .tocsub td { 435 | line-height: 1.3; 436 | } 437 | 438 | 439 | .tocview table, .tocsub table { 440 | width: 90%; 441 | } 442 | 443 | .tocset td a.tocviewselflink { 444 | font-weight: lighter; 445 | font-size: 110%; /* monospaced styles below don't need to enlarge */ 446 | color: white; 447 | } 448 | 449 | .tocviewselflink { 450 | text-decoration: none; 451 | } 452 | 453 | .tocsub { 454 | text-align: left; 455 | margin-top: 0.5em; 456 | background-color: inherit; 457 | } 458 | 459 | .tocviewlist, .tocsublist { 460 | margin-left: 0.2em; 461 | margin-right: 0.2em; 462 | padding-top: 0.2em; 463 | padding-bottom: 0.2em; 464 | } 465 | .tocviewlist table { 466 | font-size: 82%; 467 | } 468 | 469 | .tocviewlisttopspace { 470 | margin-bottom: 1em; 471 | } 472 | 473 | .tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom { 474 | margin-left: 0.4em; 475 | border-left: 1px solid #99a; 476 | padding-left: 0.8em; 477 | } 478 | .tocviewsublist { 479 | margin-bottom: 1em; 480 | } 481 | .tocviewsublist table, 482 | .tocviewsublistonly table, 483 | .tocviewsublisttop table, 484 | .tocviewsublistbottom table, 485 | table.tocsublist { 486 | font-size: 1rem; 487 | } 488 | 489 | .tocviewsublist td, .tocviewsublistbottom td, .tocviewsublisttop td, .tocsub td, 490 | .tocviewsublistonly td { 491 | font-size: 90%; 492 | } 493 | 494 | 495 | .tocviewtoggle { 496 | font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */ 497 | } 498 | 499 | .tocsublist td { 500 | padding-left: 0.5rem; 501 | padding-top: 0.25rem; 502 | text-indent: 0; 503 | } 504 | 505 | .tocsublinknumber { 506 | font-size: 100%; 507 | } 508 | 509 | .tocsublink { 510 | font-size: 82%; 511 | text-decoration: none; 512 | } 513 | 514 | .tocsubseclink { 515 | font-size: 100%; 516 | text-decoration: none; 517 | } 518 | 519 | .tocsubnonseclink { 520 | font-size: 82%; 521 | text-decoration: none; 522 | margin-left: 1rem; 523 | padding-left: 0; 524 | display: inline-block; 525 | } 526 | 527 | /* the label "on this page" */ 528 | .tocsubtitle { 529 | display: block; 530 | font-size: 62%; 531 | font-family: 'Fira'; 532 | font-weight: bolder; 533 | font-style: normal; 534 | letter-spacing: 2px; 535 | text-transform: uppercase; 536 | margin: 0.5em; 537 | } 538 | 539 | .toptoclink { 540 | font-weight: bold; 541 | font-size: 110%; 542 | margin-bottom: 0.5rem; 543 | margin-top: 1.5rem; 544 | display: inline-block; 545 | } 546 | 547 | .toclink { 548 | font-size: inherit; 549 | } 550 | 551 | /* ---------------------------------------- */ 552 | /* Some inline styles */ 553 | 554 | .indexlink { 555 | text-decoration: none; 556 | } 557 | 558 | pre { 559 | margin-left: 2em; 560 | } 561 | 562 | blockquote { 563 | margin-left: 2em; 564 | margin-right: 2em; 565 | margin-bottom: 1em; 566 | } 567 | 568 | .SCodeFlow { 569 | border-left: 1px dotted black; 570 | padding-left: 1em; 571 | padding-right: 1em; 572 | margin-top: 1em; 573 | margin-bottom: 1em; 574 | margin-left: 0em; 575 | margin-right: 2em; 576 | white-space: nowrap; 577 | line-height: 1.5; 578 | } 579 | 580 | .SCodeFlow img { 581 | margin-top: 0.5em; 582 | margin-bottom: 0.5em; 583 | } 584 | 585 | .boxed { 586 | margin: 0; 587 | margin-top: 2em; 588 | padding: 0.25em; 589 | padding-bottom: 0.5em; 590 | background: #f3f3f3; 591 | box-sizing:border-box; 592 | border-top: 1px solid #99b; 593 | background: hsl(216, 78%, 95%); 594 | background: -moz-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%); 595 | background: -webkit-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%); 596 | background: -o-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%); 597 | background: -ms-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%); 598 | background: linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%); 599 | } 600 | 601 | blockquote > blockquote.SVInsetFlow { 602 | /* resolves issue in e.g. /reference/notation.html */ 603 | margin-top: 0em; 604 | } 605 | 606 | .leftindent .SVInsetFlow { /* see e.g. section 4.5 of Racket Guide */ 607 | margin-top: 1em; 608 | margin-bottom: 1em; 609 | } 610 | 611 | .SVInsetFlow a, .SCodeFlow a { 612 | color: #07A; 613 | font-weight: 500; 614 | } 615 | 616 | .SubFlow { 617 | display: block; 618 | margin: 0em; 619 | } 620 | 621 | .boxed { 622 | width: 100%; 623 | background-color: inherit; 624 | } 625 | 626 | .techoutside { text-decoration: none; } 627 | 628 | .SAuthorListBox { 629 | position: static; 630 | float: none; 631 | font-family: 'Fira'; 632 | font-weight: 300; 633 | font-size: 110%; 634 | margin-top: 1rem; 635 | margin-bottom: 3rem; 636 | width: 30rem; 637 | height: auto; 638 | } 639 | 640 | .author > a { /* email links within author block */ 641 | font-weight: inherit; 642 | color: inherit; 643 | } 644 | 645 | .SAuthorList { 646 | font-size: 82%; 647 | } 648 | .SAuthorList:before { 649 | content: "by "; 650 | } 651 | .author { 652 | display: inline; 653 | white-space: nowrap; 654 | } 655 | 656 | /* phone + tablet styles */ 657 | 658 | @media all and (max-width:720px){ 659 | 660 | 661 | @media all and (max-width:720px){ 662 | 663 | @media all {html {font-size: 15px;}} 664 | @media all and (max-width:700px){html {font-size: 14px;}} 665 | @media all and (max-width:630px){html {font-size: 13px;}} 666 | @media all and (max-width:610px){html {font-size: 12px;}} 667 | @media all and (max-width:550px){html {font-size: 11px;}} 668 | @media all and (max-width:520px){html {font-size: 10px;}} 669 | 670 | .navsettop, .navsetbottom { 671 | display: block; 672 | position: absolute; 673 | width: 100%; 674 | height: 4rem; 675 | border: 0; 676 | background-color: hsl(216, 15%, 70%); 677 | } 678 | 679 | .searchform { 680 | display: inline; 681 | border: 0; 682 | } 683 | 684 | .navright { 685 | position: absolute; 686 | right: 1.5rem; 687 | margin-top: 1rem; 688 | border: 0px solid red; 689 | } 690 | 691 | .navsetbottom { 692 | display: block; 693 | margin-top: 8rem; 694 | } 695 | 696 | .tocset { 697 | display: none; 698 | } 699 | 700 | .tocset table, .tocset tbody, .tocset tr, .tocset td { 701 | display: inline; 702 | } 703 | 704 | .tocview { 705 | display: none; 706 | } 707 | 708 | .tocsub .tocsubtitle { 709 | display: none; 710 | } 711 | 712 | .versionbox { 713 | top: 4.5rem; 714 | left: 1rem; /* same distance as main-column */ 715 | z-index: 11000; 716 | height: 2em; 717 | font-size: 70%; 718 | font-weight: lighter; 719 | } 720 | 721 | 722 | .maincolumn { 723 | margin-left: 1em; 724 | margin-top: 7rem; 725 | margin-bottom: 0rem; 726 | } 727 | 728 | } 729 | 730 | } 731 | 732 | /* print styles : hide the navigation elements */ 733 | @media print { 734 | .tocset, 735 | .navsettop, 736 | .navsetbottom { display: none; } 737 | .maincolumn { 738 | width: auto; 739 | margin-right: 13em; 740 | margin-left: 0; 741 | } 742 | } -------------------------------------------------------------------------------- /docs/racket.css: -------------------------------------------------------------------------------- 1 | 2 | /* See the beginning of "scribble.css". */ 3 | 4 | /* Monospace: */ 5 | .RktIn, .RktRdr, .RktPn, .RktMeta, 6 | .RktMod, .RktKw, .RktVar, .RktSym, 7 | .RktRes, .RktOut, .RktCmt, .RktVal, 8 | .RktBlk { 9 | font-family: monospace; 10 | white-space: inherit; 11 | } 12 | 13 | /* Serif: */ 14 | .inheritedlbl { 15 | font-family: serif; 16 | } 17 | 18 | /* Sans-serif: */ 19 | .RBackgroundLabelInner { 20 | font-family: sans-serif; 21 | } 22 | 23 | /* ---------------------------------------- */ 24 | /* Inherited methods, left margin */ 25 | 26 | .inherited { 27 | width: 100%; 28 | margin-top: 0.5em; 29 | text-align: left; 30 | background-color: #ECF5F5; 31 | } 32 | 33 | .inherited td { 34 | font-size: 82%; 35 | padding-left: 1em; 36 | text-indent: -0.8em; 37 | padding-right: 0.2em; 38 | } 39 | 40 | .inheritedlbl { 41 | font-style: italic; 42 | } 43 | 44 | /* ---------------------------------------- */ 45 | /* Racket text styles */ 46 | 47 | .RktIn { 48 | color: #cc6633; 49 | background-color: #eeeeee; 50 | } 51 | 52 | .RktInBG { 53 | background-color: #eeeeee; 54 | } 55 | 56 | .RktRdr { 57 | } 58 | 59 | .RktPn { 60 | color: #843c24; 61 | } 62 | 63 | .RktMeta { 64 | color: black; 65 | } 66 | 67 | .RktMod { 68 | color: black; 69 | } 70 | 71 | .RktOpt { 72 | color: black; 73 | } 74 | 75 | .RktKw { 76 | color: black; 77 | } 78 | 79 | .RktErr { 80 | color: red; 81 | font-style: italic; 82 | } 83 | 84 | .RktVar { 85 | color: #262680; 86 | font-style: italic; 87 | } 88 | 89 | .RktSym { 90 | color: #262680; 91 | } 92 | 93 | .RktSymDef { /* used with RktSym at def site */ 94 | } 95 | 96 | .RktValLink { 97 | text-decoration: none; 98 | color: blue; 99 | } 100 | 101 | .RktValDef { /* used with RktValLink at def site */ 102 | } 103 | 104 | .RktModLink { 105 | text-decoration: none; 106 | color: blue; 107 | } 108 | 109 | .RktStxLink { 110 | text-decoration: none; 111 | color: black; 112 | } 113 | 114 | .RktStxDef { /* used with RktStxLink at def site */ 115 | } 116 | 117 | .RktRes { 118 | color: #0000af; 119 | } 120 | 121 | .RktOut { 122 | color: #960096; 123 | } 124 | 125 | .RktCmt { 126 | color: #c2741f; 127 | } 128 | 129 | .RktVal { 130 | color: #228b22; 131 | } 132 | 133 | /* ---------------------------------------- */ 134 | /* Some inline styles */ 135 | 136 | .together { 137 | width: 100%; 138 | } 139 | 140 | .prototype, .argcontract, .RBoxed { 141 | white-space: nowrap; 142 | } 143 | 144 | .prototype td { 145 | vertical-align: text-top; 146 | } 147 | 148 | .RktBlk { 149 | white-space: inherit; 150 | text-align: left; 151 | } 152 | 153 | .RktBlk tr { 154 | white-space: inherit; 155 | } 156 | 157 | .RktBlk td { 158 | vertical-align: baseline; 159 | white-space: inherit; 160 | } 161 | 162 | .argcontract td { 163 | vertical-align: text-top; 164 | } 165 | 166 | .highlighted { 167 | background-color: #ddddff; 168 | } 169 | 170 | .defmodule { 171 | width: 100%; 172 | background-color: #F5F5DC; 173 | } 174 | 175 | .specgrammar { 176 | float: right; 177 | } 178 | 179 | .RBibliography td { 180 | vertical-align: text-top; 181 | } 182 | 183 | .leftindent { 184 | margin-left: 1em; 185 | margin-right: 0em; 186 | } 187 | 188 | .insetpara { 189 | margin-left: 1em; 190 | margin-right: 1em; 191 | } 192 | 193 | .Rfilebox { 194 | } 195 | 196 | .Rfiletitle { 197 | text-align: right; 198 | margin: 0em 0em 0em 0em; 199 | } 200 | 201 | .Rfilename { 202 | border-top: 1px solid #6C8585; 203 | border-right: 1px solid #6C8585; 204 | padding-left: 0.5em; 205 | padding-right: 0.5em; 206 | background-color: #ECF5F5; 207 | } 208 | 209 | .Rfilecontent { 210 | margin: 0em 0em 0em 0em; 211 | } 212 | 213 | .RpackageSpec { 214 | padding-right: 0.5em; 215 | } 216 | 217 | /* ---------------------------------------- */ 218 | /* For background labels */ 219 | 220 | .RBackgroundLabel { 221 | float: right; 222 | width: 0px; 223 | height: 0px; 224 | } 225 | 226 | .RBackgroundLabelInner { 227 | position: relative; 228 | width: 25em; 229 | left: -25.5em; 230 | top: 0px; 231 | text-align: right; 232 | color: white; 233 | z-index: 0; 234 | font-weight: bold; 235 | } 236 | 237 | .RForeground { 238 | position: relative; 239 | left: 0px; 240 | top: 0px; 241 | z-index: 1; 242 | } 243 | 244 | /* ---------------------------------------- */ 245 | /* History */ 246 | 247 | .SHistory { 248 | font-size: 82%; 249 | } 250 | -------------------------------------------------------------------------------- /docs/scribble-common.js: -------------------------------------------------------------------------------- 1 | // Common functionality for PLT documentation pages 2 | 3 | // Page Parameters ------------------------------------------------------------ 4 | 5 | var page_query_string = location.search.substring(1); 6 | 7 | var page_args = 8 | ((function(){ 9 | if (!page_query_string) return []; 10 | var args = page_query_string.split(/[&;]/); 11 | for (var i=0; i= 0) args[i] = [a.substring(0,p), a.substring(p+1)]; 15 | else args[i] = [a, false]; 16 | } 17 | return args; 18 | })()); 19 | 20 | function GetPageArg(key, def) { 21 | for (var i=0; i= 0 && cur.substring(0,eql) == key) 78 | return unescape(cur.substring(eql+1)); 79 | } 80 | return def; 81 | } 82 | } 83 | 84 | function SetCookie(key, val) { 85 | try { 86 | localStorage[key] = val; 87 | } catch(e) { 88 | var d = new Date(); 89 | d.setTime(d.getTime()+(365*24*60*60*1000)); 90 | try { 91 | document.cookie = 92 | key + "=" + escape(val) + "; expires="+ d.toGMTString() + "; path=/"; 93 | } catch (e) {} 94 | } 95 | } 96 | 97 | // note that this always stores a directory name, ending with a "/" 98 | function SetPLTRoot(ver, relative) { 99 | var root = location.protocol + "//" + location.host 100 | + NormalizePath(location.pathname.replace(/[^\/]*$/, relative)); 101 | SetCookie("PLT_Root."+ver, root); 102 | } 103 | 104 | // adding index.html works because of the above 105 | function GotoPLTRoot(ver, relative) { 106 | var u = GetCookie("PLT_Root."+ver, null); 107 | if (u == null) return true; // no cookie: use plain up link 108 | // the relative path is optional, default goes to the toplevel start page 109 | if (!relative) relative = "index.html"; 110 | location = u + relative; 111 | return false; 112 | } 113 | 114 | // Utilities ------------------------------------------------------------------ 115 | 116 | var normalize_rxs = [/\/\/+/g, /\/\.(\/|$)/, /\/[^\/]*\/\.\.(\/|$)/]; 117 | function NormalizePath(path) { 118 | var tmp, i; 119 | for (i = 0; i < normalize_rxs.length; i++) 120 | while ((tmp = path.replace(normalize_rxs[i], "/")) != path) path = tmp; 121 | return path; 122 | } 123 | 124 | // `noscript' is problematic in some browsers (always renders as a 125 | // block), use this hack instead (does not always work!) 126 | // document.write(""); 127 | 128 | // Interactions --------------------------------------------------------------- 129 | 130 | function DoSearchKey(event, field, ver, top_path) { 131 | var val = field.value; 132 | if (event && event.keyCode == 13) { 133 | var u = GetCookie("PLT_Root."+ver, null); 134 | if (u == null) u = top_path; // default: go to the top path 135 | u += "search/index.html?q=" + encodeURIComponent(val); 136 | u = MergePageArgsIntoUrl(u); 137 | location = u; 138 | return false; 139 | } 140 | return true; 141 | } 142 | 143 | function TocviewToggle(glyph, id) { 144 | var s = document.getElementById(id).style; 145 | var expand = s.display == "none"; 146 | s.display = expand ? "block" : "none"; 147 | glyph.innerHTML = expand ? "▼" : "►"; 148 | } 149 | 150 | // Page Init ------------------------------------------------------------------ 151 | 152 | // Note: could make a function that inspects and uses window.onload to chain to 153 | // a previous one, but this file needs to be required first anyway, since it 154 | // contains utilities for all other files. 155 | var on_load_funcs = []; 156 | function AddOnLoad(fun) { on_load_funcs.push(fun); } 157 | window.onload = function() { 158 | for (var i=0; i 415 | .techinside doesn't work with IE, so use both (and IE doesn't 416 | work with inherit in the second one, so use blue directly) */ 417 | .techinside { color: black; } 418 | .techinside:hover { color: blue; } 419 | .techoutside:hover>.techinside { color: inherit; } 420 | 421 | .SCentered { 422 | text-align: center; 423 | } 424 | 425 | .imageleft { 426 | float: left; 427 | margin-right: 0.3em; 428 | } 429 | 430 | .Smaller { 431 | font-size: 82%; 432 | } 433 | 434 | .Larger { 435 | font-size: 122%; 436 | } 437 | 438 | /* A hack, inserted to break some Scheme ids: */ 439 | .mywbr { 440 | display: inline-block; 441 | height: 0; 442 | width: 0; 443 | font-size: 1px; 444 | } 445 | 446 | .compact li p { 447 | margin: 0em; 448 | padding: 0em; 449 | } 450 | 451 | .noborder img { 452 | border: 0; 453 | } 454 | 455 | .SAuthorListBox { 456 | position: relative; 457 | float: right; 458 | left: 2em; 459 | top: -2.5em; 460 | height: 0em; 461 | width: 13em; 462 | margin: 0em -13em 0em 0em; 463 | } 464 | .SAuthorList { 465 | font-size: 82%; 466 | } 467 | .SAuthorList:before { 468 | content: "by "; 469 | } 470 | .author { 471 | display: inline; 472 | white-space: nowrap; 473 | } 474 | 475 | /* print styles : hide the navigation elements */ 476 | @media print { 477 | .tocset, 478 | .navsettop, 479 | .navsetbottom { display: none; } 480 | .maincolumn { 481 | width: auto; 482 | margin-right: 13em; 483 | margin-left: 0; 484 | } 485 | } 486 | -------------------------------------------------------------------------------- /docs/sorts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/docs/sorts.png -------------------------------------------------------------------------------- /docs/sorts_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/docs/sorts_2.png -------------------------------------------------------------------------------- /docs/sorts_3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/docs/sorts_3.png -------------------------------------------------------------------------------- /docs/sorts_4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/docs/sorts_4.png -------------------------------------------------------------------------------- /examples/Mass_spring.svg.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/examples/Mass_spring.svg.png -------------------------------------------------------------------------------- /examples/boolean.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @title{Boolean algebra} 4 | @author{Konrad Hinsen} 5 | 6 | @context["boolean" #:use "builtins/truth"]{ 7 | @section{Logical operations} 8 | 9 | The following operators are defined on terms of sort @sort{boolean}: 10 | 11 | @tabular[#:sep @hspace[1] 12 | @list[ @list["NOT:" @op{¬(boolean) : boolean}] 13 | @list["AND:" @op{boolean ∧ boolean : boolean}] 14 | @list["OR:" @op{boolean ∨ boolean : boolean}] 15 | @list["XOR:" @op{boolean ⊻ boolean : boolean}] ]] 16 | 17 | @subsection{Rewrite rules} 18 | 19 | @subsubsection{Eliminate NOT and OR} 20 | 21 | NOT is replaced by XOR with @term{true}: 22 | @inset{@rule{¬(X) ⇒ true ⊻ X ∀ X:boolean}} 23 | 24 | OR is replaced by XOR and AND: 25 | @inset{@rule{X ∨ Y ⇒ X ⊻ Y ⊻ (X ∧ Y) ∀ X:boolean ∀ Y:boolean}} 26 | 27 | @subsubsection{Simplify AND relations} 28 | 29 | AND is @term{false} if one of its arguments is @term{false}: 30 | @inset{@rule{X ∧ false ⇒ false ∀ X:boolean} 31 | @rule{false ∧ X ⇒ false ∀ X:boolean}} 32 | 33 | If one argument of AND is @term{true}, the result is the other argument: 34 | @inset{@rule{X ∧ true ⇒ X ∀ X:boolean} 35 | @rule{true ∧ X ⇒ X ∀ X:boolean}} 36 | 37 | If the two arguments to AND are equal, they are also equal to the result: 38 | @inset{@rule{X ∧ X ⇒ X ∀ X:boolean}} 39 | 40 | @subsubsection{Simplify XOR relations} 41 | 42 | XOR with @term{false} leaves truth values unchanged: 43 | @inset{@rule{X ⊻ false ⇒ X ∀ X:boolean} 44 | @rule{false ⊻ X ⇒ X ∀ X:boolean}} 45 | 46 | If the two arguments to XOR are equal, the result is @term{false}: 47 | @inset{@rule{X ⊻ X ⇒ false ∀ X:boolean}} 48 | 49 | @subsubsection{Standardize combinations of XOR and AND} 50 | 51 | The above rules will reduce any boolean expression to a combination of XOR and AND 52 | operations that allow no further simplification. However, it is still possible that 53 | logically equal expressions are rewritten into distinct syntactical forms, making it 54 | difficult to verify that they are equal. The following rule standardizes results 55 | by replacing XOR inside AND by AND inside XOR: 56 | @inset{@rule{X ∧ (Y ⊻ Z) ⇒ (X ∧ Y) ⊻ (X ∧ Z) 57 | ∀ X:boolean ∀ Y:boolean ∀ Z:boolean}} 58 | 59 | 60 | @subsection{Tests} 61 | 62 | Truth table for Not: 63 | @inset{@test{¬(false) ⇒ true} 64 | @test{¬(true) ⇒ false}} 65 | 66 | Truth table for AND: 67 | @inset{@test{false ∧ false ⇒ false} 68 | @test{false ∧ true ⇒ false} 69 | @test{true ∧ false ⇒ false} 70 | @test{true ∧ true ⇒ true}} 71 | 72 | Truth table for OR: 73 | @inset{@test{false ∨ false ⇒ false} 74 | @test{false ∨ true ⇒ true} 75 | @test{true ∨ false ⇒ true} 76 | @test{true ∨ true ⇒ true}} 77 | 78 | Truth table for XOR: 79 | @inset{@test{false ⊻ false ⇒ false} 80 | @test{false ⊻ true ⇒ true} 81 | @test{true ⊻ false ⇒ true} 82 | @test{true ⊻ true ⇒ false}} 83 | 84 | } 85 | -------------------------------------------------------------------------------- /examples/euclid_gcd.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @title{The greatest common divisor of two natural numbers} 4 | @author{Euclid} 5 | 6 | @context["gcd" #:use "builtins/integers"]{ 7 | 8 | The greatest common divisor @op{gcd(a:ℕ, b:ℕ) : ℕ} of two natural numbers @var{a:ℕ} and @var{b:ℕ} can be obtained by applying the following rules: 9 | @itemlist[#:style 'ordered 10 | @item{If the two numbers are equal, their GCD is equal to them as well: 11 | @linebreak[] 12 | @rule{gcd(a, a) ⇒ a}} 13 | @item{If a > b, replace a by a-b: 14 | @linebreak[] 15 | @rule{gcd(a, b) ⇒ gcd(a - b, b) if a > b}} 16 | @item{Otherwise we have b > a and replace b by b-a: 17 | @linebreak[] 18 | @rule{gcd(a, b) ⇒ gcd(a, b - a)}}] 19 | 20 | Here are some application examples: 21 | @itemlist[ 22 | @item{@eval-term{gcd(2, 3)}} 23 | @item{@eval-term{gcd(3, 2)}} 24 | @item{@eval-term{gcd(42, 7)}}] 25 | 26 | } -------------------------------------------------------------------------------- /examples/functions.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @title{Functions} 4 | @author{Konrad Hinsen} 5 | 6 | @context["ℝ→ℝ" 7 | #:use "builtins/real-numbers"]{ 8 | 9 | @section{Real functions of one variable} 10 | 11 | The sort @sort{ℝ→ℝ} describes real functions of one real variable. 12 | Function application is defined by @op{ℝ→ℝ[ℝ] : ℝ}. Note that this 13 | implies that the domain of the function is the full set of real 14 | numbers, which excludes functions with singularities as well as 15 | partial functions. 16 | 17 | It is convenient to provide basic arithmetic on functions: 18 | @itemlist[ 19 | @item{@op{f:ℝ→ℝ + g:ℝ→ℝ : ℝ→ℝ} with @linebreak[] 20 | @rule{(f + g)[x] ⇒ f[x] + g[x] ∀ x:ℝ}} 21 | @item{@op{f:ℝ→ℝ - g:ℝ→ℝ : ℝ→ℝ} with @linebreak[] 22 | @rule{(f - g)[x] ⇒ f[x] - g[x] ∀ x:ℝ}} 23 | @item{@op{f:ℝ→ℝ × g:ℝ→ℝ : ℝ→ℝ} with @linebreak[] 24 | @rule{(f × g)[x] ⇒ f[x] × g[x] ∀ x:ℝ}} 25 | @item{@op{s:ℝ × g:ℝ→ℝ : ℝ→ℝ} with @linebreak[] 26 | @rule{(s × g)[x] ⇒ s × g[x] ∀ x:ℝ}}] 27 | 28 | We do not define division as this requires more elaborate definitions 29 | to handle the case of functions with zeros. 30 | 31 | Function composition is defined by 32 | @inset{@op{f:ℝ→ℝ ○ g:ℝ→ℝ : ℝ→ℝ} with 33 | @rule{(f ○ g)[x] ⇒ f[g[x]] ∀ x:ℝ}} 34 | } 35 | 36 | @context["derivatives-ℝ→ℝ" 37 | #:extend "ℝ→ℝ"]{ 38 | 39 | @section{Derivatives} 40 | 41 | The derivative of a function is given by @op{𝒟(ℝ→ℝ) : ℝ→ℝ}, which is 42 | a linear operator: 43 | @inset{@rule{𝒟(f + g) ⇒ 𝒟(f) + 𝒟(g)} 44 | @rule{𝒟(f - g) ⇒ 𝒟(f) - 𝒟(g)} 45 | @rule{𝒟(s × f) ⇒ s × 𝒟(f)}} 46 | 47 | The derivatives of products and compositions of two functions are given by: 48 | @inset{@rule{𝒟(f × g) ⇒ (𝒟(f) × g) + (f × 𝒟(g))} 49 | @rule{𝒟(f ○ g) ⇒ (𝒟(f) ○ g) × 𝒟(g)}} 50 | 51 | } 52 | 53 | @context["finite-differences-ℝ→ℝ" 54 | #:extend "ℝ→ℝ"]{ 55 | 56 | @section{Finite difference operators} 57 | 58 | In numerical calculations, derivatives must often be approximated by finite 59 | differences. Since there are many possible schemes for computing finite differences, 60 | we define multiple @sort{finite-difference-operator}s with 61 | @op{finite-difference-operator[fn:ℝ→ℝ, h:ℝ] : ℝ→ℝ}, where @term{h} is the step size. 62 | 63 | Next, we define @op{Δ : finite-difference-family} and @sort{finite-difference-scheme} 64 | such that @op{finite-difference-family_{finite-difference-scheme} : finite-difference-operator}. 65 | 66 | With these definitions, the three most common finite-difference schemes are: 67 | @itemlist[ 68 | @item{@op{forward : finite-difference-scheme}: @linebreak[] 69 | @rule{Δ_{forward}[fn, h][x] ⇒ (fn[x + h] - fn[x]) ÷ h ∀ x:ℝ}} 70 | @item{@op{backward : finite-difference-scheme}: @linebreak[] 71 | @rule{Δ_{backward}[fn, h][x] ⇒ (fn[x] - fn[x - h]) ÷ h ∀ x:ℝ}} 72 | @item{@op{central : finite-difference-scheme}: @linebreak[] 73 | @rule{Δ_{central}[fn, h][x] ⇒ (fn[x + (h ÷ 2)] - fn[x - (h ÷ 2)]) ÷ h ∀ x:ℝ}}] 74 | } -------------------------------------------------------------------------------- /examples/heron.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @title{Heron's algorithm} 4 | @author{Konrad Hinsen} 5 | 6 | Heron's algorithm computes the square root of an input number @italic{x} iteratively, 7 | starting from an initial estimate @italic{e}, until the result is 8 | correct within a given tolerance @italic{ε}. It is a special case of Newton's method 9 | for finding roots of algebraic equations. 10 | 11 | @context["heron" #:use "builtins/real-numbers"]{ 12 | 13 | @section{Heron's algorithm using exact arithmetic} 14 | 15 | Let @op{heron(x:ℝnn, ε:ℝp, e:ℝnn) : ℝnn} 16 | be the result of Heron's algorithm for computing the square root of @term{x} 17 | up to tolerance @term{ε}, starting from estimate @term{e}. 18 | 19 | The first step of the algorithm is to check if the current approximation is good enough, 20 | in which case it is the final result: 21 | @inset{@rule{heron(x, ε, e) ⇒ e 22 | if abs(x - e^{2}) < ε}} 23 | Note that the tolerance applies to @term{x} and not to @term{√(x)}. 24 | 25 | Otherwise, a new estimate is computed by taking the average 26 | of @italic{e} and @italic{x} ÷ @italic{e}: 27 | @inset{@rule{heron(x, ε, e) ⇒ heron(x, ε, 1/2 × (e + (x ÷ e)))}} 28 | 29 | For convenience, we also allow no initial estimate to be supplied, using 30 | a default value of 1: 31 | @inset{@op{heron(x:ℝnn, ε:ℝp) : ℝnn} 32 | @rule{heron(x, ε) ⇒ heron(x, ε, 1)}} 33 | The iteration starting from 1 will always converge but could well be inefficient. 34 | 35 | @subsection{Tests} 36 | 37 | We can use this algorithm with rational number arguments: 38 | @inset{@test{heron(2, 1/2)^{2} - 2 ⇒ 1/4} 39 | @test{heron(2, 1/10)^{2} - 2 ⇒ 1/144} 40 | @test{heron(2, 1/100)^{2} - 2 ⇒ 1/144} 41 | @test{heron(2, 1/200)^{2} - 2 ⇒ 1/166464}} 42 | We see that decreasing @term{ε} leads to better approximations of √2, which are 43 | always within the prescribed tolerance. 44 | } 45 | 46 | @context["fp-heron" 47 | #:insert-extend ["heron" (real->float FP64)]]{ 48 | 49 | @section{Heron's algorithm using floating-point arithmetic} 50 | 51 | A floating-point version of Heron's algorithm can be obtained by automatic 52 | conversion: 53 | 54 | @show-context["fp-heron"] 55 | 56 | @subsection{Tests} 57 | 58 | We can use this version with floating-point arguments: 59 | @inset{@test{heron(2., 0.5)^{2} - 2. ⇒ 0.25} 60 | @eval-term{heron(2., 0.5) - √(2.)} 61 | @test{abs(heron(2., 0.1)^{2} - 2.) < 0.1 ⇒ true} 62 | @eval-term{heron(2., 0.1) - √(2.)} 63 | @test{abs(heron(2., 0.01)^{2} - 2.) < 0.01 ⇒ true} 64 | @eval-term{heron(2., 0.01) - √(2.)} 65 | @test{abs(heron(2., 0.001)^{2} - 2.) < 0.001 ⇒ true} 66 | @eval-term{heron(2., 0.001) - √(2.)}} 67 | 68 | Again we see that decreasing @term{ε} leads to better approximations of @term{√(2.)}. 69 | The deviation is always smaller than the prescribed tolerance. 70 | } 71 | 72 | @;signature-graphs["heron.sig"] 73 | -------------------------------------------------------------------------------- /examples/leibniz-by-example.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @title{Leibniz by example} 4 | @author{Konrad Hinsen} 5 | 6 | @import["functions" "functions.xml"] 7 | 8 | @context["predator-prey" #:use "functions/derivatives-ℝ→ℝ"]{ 9 | 10 | Let's start right away with an example, the explanations will follow in the 11 | next section. 12 | 13 | @section{Example: the predator-prey equations} 14 | 15 | The predator-prey equations, also known as the Lotka-Volterra equations, describe the dynamics of two interacting species in an ecosystem in terms of non-linear differential equations. 16 | 17 | The two interacting time-dependent observables are the number of prey, @op{prey : ℝ→ℝ}, and the number of predators, @op{predators : ℝ→ℝ}. Although the number of individuals of a species is really an integer, it is taken to be a real number for the benefit of using differential equations. The two coupled equations for @term{prey} and @term{predators} 18 | are 19 | @inset{ 20 | @equation[pp1]{𝒟(prey) = (prey-growth-rate × prey) - (predation-rate × predators × prey)} 21 | @equation[pp2]{𝒟(predators) = (predator-growth-rate × predators × prey) - (predator-loss-rate × predators)}} 22 | 23 | These equations are based on a few assumptions: 24 | @itemlist[ 25 | @item{In the absence of predators, the prey exihibits exponential growth described by @op{prey-growth-rate : ℝp}.} 26 | @item{The number of prey decreases by predation, which is @op{predation-rate : ℝp} times the number of encounters between individuals of each species. The latter is taken to be proportional to both @term{prey} and @term{predators}.} 27 | @item{In the absence of prey, the number of predators decreases by starvation, described by @op{predator-loss-rate : ℝp}.} 28 | @item{The number of predators grows with the availability of food, which, like predation, is proportional to both @term{prey} and @term{predators} with the proportionality constant @op{predator-growth-rate : ℝp}.}] 29 | 30 | } 31 | 32 | @context["predator-prey-explanation" #:extend "predator-prey"]{ 33 | 34 | @section{A guide to reading this example} 35 | 36 | @itemlist[ 37 | @item{Everything typeset on a light blue background is Leibniz code. Everything else is plain text.} 38 | @item{The boldface parts (@bold{pp1}, @bold{pp2}) are equation labels that can be used to refer to a specific equation.} 39 | @item{@sort{ℝ} stands for the real numbers, @sort{ℝp} for the positive real numbers, and @sort{ℝ→ℝ} for real functions 40 | of one real variable. If @op{f : ℝ→ℝ} is such a function, then @term{𝒟(f)} is the derivative of @term{f}. All these 41 | definitions come from the imported context "functions/ℝ→ℝ" whose definition you can see 42 | @hyperlink["http://khinsen.net/leibniz-examples/examples/functions.html"]{here}. 43 | Yes, that link should be in the example itself, and it will be.}] 44 | } 45 | 46 | @section{Why Leibniz?} 47 | 48 | Compare the example in the first section with the beginning of the 49 | @hyperlink["https://en.wikipedia.org/wiki/Lotka%E2%80%93Volterra_equations"]{Wikipedia entry} 50 | on the same topic, which uses traditional mathematical notation. If Wikipedia adopted Leibniz, what would it gain? 51 | 52 | @itemlist[#:style 'ordered 53 | @item{A machine-readable version of the predator-prey equations, generated from the same input and therefore identical in content. 54 | You can look at it @hyperlink["http://khinsen.net/leibniz-examples/examples/leibniz-by-example.xml"]{here}. It's an XML file, 55 | which your browser may not display nicely, but you can always download it and open it in a text editor. 56 | A Leibniz-aware solver for differential equations could read this file, prompt you for parameter values and initial values, 57 | and compute and plot a solution. And if you had two Leibniz-aware solvers, you could compare their output, knowing for sure 58 | that they work on the same equations. Better yet, they work on the same equations that you have read and understood 59 | while reading the explanation. No more mistakes in transcribing equations to code!} 60 | @item{A more precise notation. For example, in the Wikipedia text, it is not immediately clear that @italic{x} and @italic{y} are 61 | functions of time, whereas @italic{α}, @italic{β}, @italic{γ}, @italic{δ} are constants. In Leibniz, you have to say 62 | what each object is, and you get an error message if you try to take the derivative of something that is not a function. 63 | More generally, everything typeset on a blue background has been checked for consistency and completeness.}] 64 | 65 | @section{What else can you do with Leibniz?} 66 | 67 | This simple example doesn't illustrate all the features of Leibniz. Moreover, Leibniz is far from complete at this time. 68 | Here are some things that you can do, or will soon be able to do, using Leibniz: 69 | 70 | @itemlist[ 71 | @item{Express algorithms. Many computational models and methods in science combine equations with algorithms. 72 | We write the equations in papers using mathematical notation, and the algorithms in software source code 73 | using programming languages. Leibniz can express both, and render both in a human-readable and in a 74 | machine-readable form. See @hyperlink["http://khinsen.net/leibniz-examples/examples/euclid_gcd.html"]{here} 75 | and @hyperlink["http://khinsen.net/leibniz-examples/examples/heron.html"]{here} for simple examples of 76 | algorithms in Leibniz.} 77 | @item{Transform equations and algorithms. Start from a general model and then specialize it. Introduce approximations. 78 | Switch from exact arithmetic to floating-point arithmetic (as in 79 | @hyperlink["http://khinsen.net/leibniz-examples/examples/heron.html"]{this example}). Most importantly, 80 | do all this in a human-readable document that your peers can verify, rather than in hard-to-read 81 | software source code.} 82 | @item{Document all levels of a computational research project, from basic concepts to data anlysis workflows, 83 | using a single language, at the level of detail that you consider appropriate. You can just write an equation 84 | and stop there, as in the above example. But you can also use Leibniz to write an algorithm for solving differential 85 | equations. The general idea is that you document your research in Leibniz, but delegate what you consider technical 86 | details to Leibniz-aware software tools.} 87 | @item{Work with complex models using computational tools. Suppose your scientific model is an equation with 2000 terms. 88 | Writing it down on paper is pointless. Writing it down as a Fortran subroutine is more useful, but you cannot 89 | do anything else with that subroutine than compute specific values. If you write it down in Leibniz, you can 90 | write software to analyze it, e.g. check that every second term is positive or whatever else you know about your 91 | model. You can also compute specific values in Leibniz, and use them to test your Fortran code.} 92 | @item{Define scientific concepts with the precision of a formal language. There is no better remedy against sloppy 93 | thinking than a computer that forces you to respect your own definitions. See 94 | @hyperlink["http://sjscience.org/memberPage?uId=90&jId=6#journal"]{this article collection} for essays on this 95 | little-known aspect of computing and for practical examples.}] 96 | -------------------------------------------------------------------------------- /examples/mass-on-a-spring.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @import["mechanics" "mechanics.xml"] 4 | @import["quantities" "quantities.xml"] 5 | 6 | @title{Motion of a mass on a spring} 7 | @author{Konrad Hinsen} 8 | 9 | @context["equations-of-motion" 10 | #:use "mechanics/dynamics" 11 | #:use "quantities/angular-frequency"]{ 12 | 13 | We consider a point-like object of mass @op{m : M} attached to a 14 | spring whose mass we assume to be negligible. The other end of the 15 | spring is attached to a wall. When the particle is at position 16 | @op{x : T→L} relative to the equilibrium length @op{l : L} of the spring, 17 | the force @op{F : T→F} acting on it is proportional 18 | to @term{x}: 19 | @inset{ 20 | @equation[force]{F = -(k × x)} 21 | } 22 | where @op{k : force-constant} characterizes the elastic properties 23 | of the spring. 24 | 25 | @centered[ 26 | @image["Mass_spring.svg.png"]{Drawing} 27 | @linebreak[] 28 | @hyperlink["https://commons.wikimedia.org/wiki/File:Mass_spring.svg"]{(Source: Wikimedia Commons)} 29 | ] 30 | 31 | Newton's equation of motion for the displacement @term{x} of the mass 32 | takes the form 33 | @inset{ 34 | @equation[newton]{𝒟(𝒟(x)) = -((k ÷ m) × x)}. 35 | } 36 | 37 | @smaller{Additional arithmetic definitions for this context:} 38 | @itemlist[#:style 'ordered 39 | 40 | @item{@smaller{ 41 | A force constant times a length is a force: 42 | @linebreak[] 43 | @op{force-constant × L : F} 44 | @linebreak[] 45 | @op{force-constant × T→L : T→F} 46 | @linebreak[] 47 | @rule{(k × f)[t] ⇒ k × f[t] ∀ k:force-constant ∀ f:T→L ∀ t:T}}} 48 | 49 | @item{@smaller{ 50 | A force constant divided by a mass is the square of an angular frequency: 51 | @linebreak[] 52 | @op{force-constant ÷ M : angular-frequency-squared}}} 53 | 54 | @item{@smaller{ 55 | A squared angular frequency times a length is an acceleration: 56 | @linebreak[] 57 | @op{angular-frequency-squared × L : A} 58 | @linebreak[] 59 | @op{angular-frequency-squared × T→L : T→A} 60 | @linebreak[] 61 | @rule{(ω2 × f)[t] ⇒ ω2 × f[t] ∀ ω2:angular-frequency-squared ∀ f:T→L ∀ t:T}}} 62 | ] 63 | 64 | } 65 | 66 | @context["analytical-solution" 67 | #:extend "equations-of-motion" 68 | #:use "quantities/angular-frequency"]{ 69 | 70 | @section{Analytical solution} 71 | 72 | Introducing @op{ω : angular-frequency} defined by 73 | @equation{ω = √(k ÷ m)}, the solution of @ref[newton] can be written as 74 | @inset{ 75 | @equation[solution]{x[t] = A × cos((ω × t) + δ) ∀ t:T}, 76 | } 77 | where @op{cos(angle) : ℝ} is the cosine function. The amplitude 78 | @op{A : L} and the phase @op{δ : angle} can take arbitray values. 79 | 80 | @smaller{Additional arithmetic definitions for this context:} 81 | @inset{@smaller{ 82 | @op{√(angular-frequency-squared) : angular-frequency}}} 83 | 84 | } 85 | 86 | @section{Numerical solution} 87 | 88 | @context["euler-template" 89 | #:insert-extend ["quantities/function-with-finite-difference-template"]]{ 90 | 91 | For simplicity, we use one of the simplest numerical integration schemes known 92 | as the Euler method. It was developed in the era of manual computation, where 93 | simplicity was of utmost importance. There are much better integration schemes 94 | today, and therefore the Euler method should @italic{not} be used in practice 95 | when using a computer. 96 | 97 | In the Euler method, the derivative @term{𝒟(f)} of a time-dependent quantity 98 | @term{f} is replaced by the finite difference @term{Δ(f, h)}, where @term{h} 99 | is a small but non-zero integration step size. 100 | The finite difference is computed as 101 | @inset{@rule{Δ(f, h)[t] ⇒ (f[t + h] - f[t]) ÷ h ∀ t:SQD}.} 102 | 103 | } 104 | 105 | @context["numerical-solution" 106 | #:extend "equations-of-motion" 107 | #:insert-use ["euler-template" 108 | (rename-sort SQD T) 109 | (rename-sort SQDnz Tnz) 110 | (rename-sort SQI L) 111 | (rename-sort SQInz Lnz) 112 | (rename-sort SQID V) 113 | (rename-sort SQIDnz Vnz) 114 | (rename-sort SQD→SQI T→L) 115 | (rename-sort SQD→SQID T→V)] 116 | #:insert-use ["euler-template" 117 | (rename-sort SQD T) 118 | (rename-sort SQDnz Tnz) 119 | (rename-sort SQI V) 120 | (rename-sort SQInz Vnz) 121 | (rename-sort SQID A) 122 | (rename-sort SQIDnz Anz) 123 | (rename-sort SQD→SQI T→V) 124 | (rename-sort SQD→SQID T→A)]]{ 125 | 126 | Since the Euler integration scheme applies to first-order differential 127 | equations only, we must first transform @ref[newton] into a 128 | set of two coupled first-order equations @ref[newton1]. 129 | 130 | We introduce @op{v : T→V} representing the velocity 131 | of the mass. The definition of this velocity, 132 | @inset{@equation[newton1.x]{𝒟(x) = v},} 133 | is the first equation in our coupled set. The second one is obtained 134 | by applying the substitution @rule[subst newton1.x] to the 135 | second-order equation @ref[newton] : 136 | @inset{@substitute[newton1.v subst newton].} 137 | 138 | We can now discretize the equations @ref[newton1] by applying 139 | the substitution @rule[discretize]{𝒟(f) ⇒ Δ(f, h)}, 140 | where @var{f:Q→Q} is an arbitrary function of time 141 | and @op{h : Tnz} is the integration time step: 142 | 143 | @inset{@substitute[newtonΔ.x discretize newton1.x] 144 | @substitute[newtonΔ.v discretize newton1.v]} 145 | 146 | Applying @transformation[at-t]{f → f[t]} yields the equations for an 147 | explicit value of @op{t : T}: 148 | 149 | @inset{@transform[newtonΔ-t.x at-t newtonΔ.x #:reduce #t] 150 | @transform[newtonΔ-t.v at-t newtonΔ.v #:reduce #t]} 151 | 152 | These equations can be used to construct an iterative algorithm that computes 153 | @equation[time-series.x]{x_{n} = x[t0 + (n × h)]} and 154 | @equation[time-series.v]{v_{n} = v[t0 + (n × h)]} for any @var{n:ℕ}, given the 155 | initial values @term{x_{0}} and @term{v_{0}} at time @op{t0 : T}: 156 | 157 | @inset{@rule[algo.x]{x_{n} ⇒ x_{n - 1} + (h × v_{n - 1}) ∀ n:ℕnz} 158 | @rule[algo.v]{v_{n} ⇒ v_{n - 1} + (h × ((k ÷ m) × x_{n - 1})) ∀ n:ℕnz}} 159 | 160 | 161 | @smaller{Additional arithmetic definition for this context:} 162 | @itemlist[ 163 | 164 | @item{@smaller{ 165 | Integer indices select a time value on a grid: 166 | @linebreak[] 167 | @op{T→L_{ℤ} : L} 168 | @linebreak[] 169 | @op{T→V_{ℤ} : V}}} 170 | 171 | ] 172 | } 173 | 174 | @;signature-graphs["mass-on-a-spring.sig"] 175 | 176 | -------------------------------------------------------------------------------- /examples/masses.scrbl: -------------------------------------------------------------------------------- 1 | 2 | #lang leibniz 3 | 4 | @title{Masses and mass units} 5 | @author{Konrad Hinsen} 6 | 7 | @import["boolean" "boolean.xml"] 8 | 9 | @context["mass" #:use "builtins/real-numbers"]{ 10 | 11 | @section{Masses} 12 | 13 | The sum of two @sort{mass}es is a @sort{mass}: 14 | @inset{@op{mass + mass : mass}} 15 | 16 | The product of a positive number with a @sort{mass} is a @sort{mass}: 17 | @inset{@op{ℝp × mass : mass}} 18 | 19 | A @sort{mass} divided by a positive number is a @sort{mass}: 20 | @inset{@op{mass ÷ ℝp : mass}} 21 | 22 | The quotient of two @sort{mass}es is a positive number: 23 | @inset{@op{mass ÷ mass : ℝp}} 24 | 25 | @subsection{Simplification rules} 26 | 27 | In the following, we use the variables @var{M:mass}, @var{M1:mass}, @var{M2:mass} 28 | and @var{F:ℝp}, @var{F1:ℝp}, @var{F2:ℝp}. 29 | 30 | Combine multiples of the same mass: 31 | @inset{@rule{(F1 × M) + (F2 × M) ⇒ (F1 + F2) × M}} 32 | 33 | Replace multiple prefactors and divisions by simple prefactors: 34 | @inset{@rule{F1 × (F2 × M) ⇒ (F1 × F2) × M} 35 | @rule{M ÷ F ⇒ (1 ÷ F) × M}} 36 | 37 | Reduce quotients of two @sort{mass}es to a number if possible: 38 | @inset{@rule{M1 ÷ (F × M2) ⇒ (M1 ÷ F) ÷ M2} 39 | @rule{(F × M1) ÷ M2 ⇒ F × (M1 ÷ M2)} 40 | @rule{M ÷ M ⇒ 1}} 41 | } 42 | 43 | @context["mass-units" #:extend "mass" #:use "boolean/boolean"]{ 44 | 45 | @section{Mass units} 46 | 47 | A @sort{mass-unit ⊆ mass} is a @sort{mass} used as a reference in specifying other masses. 48 | 49 | Some common mass units are: 50 | @inset{@op{kg : mass-unit} 51 | @op{g : mass-unit} 52 | @op{mg : mass-unit}} 53 | 54 | A mass converted to another unit is a mass as well: 55 | @inset{@op{mass in mass-unit : mass}} 56 | 57 | Mass conversion is done in two steps. First all masses are expressed in 58 | terms of a @italic{pivot unit}, which is the @term{kg}. Next, the result 59 | is expressed in terms of the desired unit. Due to this two-step process, 60 | conversion factors must only be specified between each unit and the 61 | pivot unit: 62 | @inset{@rule{g ÷ kg ⇒ 1/1000} 63 | @rule{mg ÷ kg ⇒ 1/1000000}} 64 | 65 | @subsection{Simplification rules} 66 | 67 | Additional variables: @var{MU:mass-unit}, @var{MU1:mass-unit}, @var{MU2:mass-unit}. 68 | 69 | The following rule achieves unit conversion in concertation with the mass 70 | simplification rules, which reduce the quotient to a number with the help 71 | of the conversion factors: 72 | @inset{@rule{M in MU ⇒ (M ÷ MU) × MU}} 73 | 74 | Moreover, the quotient of two mass units is reduced to the quotient of their 75 | conversion factors with respect to the pivot unit: 76 | @inset{@rule{MU1 ÷ MU2 ⇒ (MU1 ÷ kg) ÷ (MU2 ÷ kg) 77 | if ¬(MU2 == kg)}} 78 | 79 | @subsection{Tests} 80 | @inset{@test{2 × (3 × kg) ⇒ 6 × kg} 81 | @test{2 × (kg ÷ 3) ⇒ 2/3 × kg} 82 | @test{(2 × kg) ÷ 3 ⇒ 2/3 × kg} 83 | @test{(2 × kg) ÷ (3 × kg) ⇒ 2/3} 84 | @test{(2 × g) ÷ (3 × kg) ⇒ 2/3000} 85 | @test{(2 × g) ÷ (3 × mg) ⇒ 2000/3} 86 | @test{(2 × g) in mg ⇒ 2000 × mg}} 87 | 88 | } 89 | -------------------------------------------------------------------------------- /examples/mechanics.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @title{Basic mechanics} 4 | @author{Konrad Hinsen} 5 | 6 | @import["quantities" "quantities.xml"] 7 | 8 | @context["kinematics" 9 | #:use "quantities/length" 10 | #:use "quantities/time" 11 | #:use "quantities/velocity" 12 | #:use "quantities/acceleration"]{ 13 | 14 | @section{Kinematics} 15 | 16 | The derived quantities @sort{V} and @sort{A} are obtained as quotients 17 | of the fundamental quantities @sort{L} and @sort{T}. 18 | 19 | Velocities are obtained by dividing a length by a time: 20 | @inset{@op{L ÷ Tnz : V} 21 | @op{Lnz ÷ Tnz : Vnz}} 22 | 23 | Accelerations are the result of dividing a velocity by a time: 24 | @inset{@op{V ÷ Tnz : A} 25 | @op{Vnz ÷ Tnz : Anz}} 26 | 27 | } 28 | 29 | @context["kinematics-example" 30 | #:extend "kinematics"]{ 31 | 32 | @subsection{Example} 33 | 34 | We consider a point that moves on a straight line starting at time 0 from the origin. 35 | At time @op{t1 : Tnz} it has distance @op{d1 : L} from the origin, at 36 | time @op{t2 : Tnz}, @term{t2 > t1} the distance is @op{d2 : L}. 37 | 38 | The average velocity from time 0 to @term{t1} is then 39 | @inset{@op{v1 : V} 40 | @rule{v1 ⇒ d1 ÷ t1}.} 41 | and the average velocity between 0 and @term{t2} is 42 | @inset{@op{v2 : V} 43 | @rule{v2 ⇒ d2 ÷ t2}.} 44 | The average acceleration is given by 45 | @inset{@op{a : A} 46 | @rule{a ⇒ 2 × ((v2 - v1) ÷ (t2 - t1))} 47 | @eval-term{a}.} 48 | 49 | } 50 | 51 | @context["kinematics-nummerical-example" 52 | #:extend "kinematics-example"]{ 53 | 54 | Introducing a time unit @op{s : Tnz} and a length unit @op{m : Lnz}, we 55 | can assign numerical values: 56 | @inset{@rule{t1 ⇒ 3 × s}, @rule{d1 ⇒ 20 × m} 57 | @rule{t2 ⇒ 6 × s}, @rule{d2 ⇒ 50 × m} 58 | @eval-term{v1} 59 | @eval-term{v2} 60 | @eval-term{a}.} 61 | 62 | } 63 | 64 | @context["time-dependent-kinematics" 65 | #:extend "kinematics" 66 | #:insert-use ["quantities/function-with-finite-difference-template" 67 | (rename-sort SQD T) 68 | (rename-sort SQDnz Tnz) 69 | (rename-sort SQI L) 70 | (rename-sort SQInz Lnz) 71 | (rename-sort SQID V) 72 | (rename-sort SQIDnz Vnz) 73 | (rename-sort SQD→SQI T→L) 74 | (rename-sort SQD→SQID T→V)] 75 | #:insert-use ["quantities/function-with-finite-difference-template" 76 | (rename-sort SQD T) 77 | (rename-sort SQDnz Tnz) 78 | (rename-sort SQI V) 79 | (rename-sort SQInz Vnz) 80 | (rename-sort SQID A) 81 | (rename-sort SQIDnz Anz) 82 | (rename-sort SQD→SQI T→V) 83 | (rename-sort SQD→SQID T→A)]]{ 84 | 85 | @section{Time-dependent kinematics} 86 | 87 | When describing motion, quantities @sort{L}, @sort{V}, and @sort{A} 88 | become functions of @sort{T}. These time-dependent quantities 89 | are written as @sort{T→L ⊆ T→Q}, @sort{T→V ⊆ T→Q}, and @sort{T→A ⊆ T→Q}, 90 | with each one being the time derivative of its predecessor. The sort 91 | @sort{T→Q ⊆ Q→Q} covers all these time-dependent quantities. 92 | } 93 | 94 | @context["dynamics" 95 | #:extend "time-dependent-kinematics" 96 | #:use "quantities/mass" 97 | #:use "quantities/force" 98 | #:insert-use ["quantities/function-template" 99 | (rename-sort SQD T) 100 | (rename-sort SQDnz Tnz) 101 | (rename-sort SQI F) 102 | (rename-sort SQInz Fnz) 103 | (rename-sort SQD→SQI T→F)]]{ 104 | 105 | @section{Dynamics} 106 | 107 | Extending kinematics to dynamics requires @sort{M} for masses, @sort{F} for forces, and 108 | @sort{T→F ⊆ T→Q} for time-dependent forces, plus the following relations between these 109 | quantities: 110 | @inset{@op{M × A : F} 111 | @op{Mnz × Anz : Fnz} 112 | @op{M × T→A : T→F} 113 | @rule{(m × f)[t] ⇒ m × f[t] ∀ m:M ∀ f:T→A ∀ t:T}} 114 | 115 | } 116 | -------------------------------------------------------------------------------- /examples/quantities.scrbl: -------------------------------------------------------------------------------- 1 | #lang leibniz 2 | 3 | @title{Physical quantities} 4 | @author{Konrad Hinsen} 5 | 6 | @context["quantities" #:use "builtins/real-numbers"]{ 7 | 8 | @section{Generic quantities} 9 | 10 | We define @sort{Q} to represent any physical quantity, and @sort{Qnz ⊆ Q} to represent 11 | the subset of non-zero quantities by which it is admissible to divide. The product and 12 | quotient of any two quantities is then again a quantity, with appropriate special cases 13 | for quantities that can be proven to be non-zero: 14 | @inset{@op{Q × Q : Qℝ} 15 | @op{Qnz × Qnz : Qℝnz} 16 | @op{Q ÷ Qnz : Qℝ} 17 | @op{Qnz ÷ Qnz : Qℝnz}} 18 | 19 | The result sort of these operators is not @sort{Q} but @sort{Qℝ} or @sort{Qℝnz ⊆ Qℝ}, 20 | because in the special case of a quotient of same-kind quantities, the result is a 21 | pure number. We therefore define 22 | @inset{@sort{Q ⊆ Qℝ} 23 | @sort{Qnz ⊆ Qℝnz} 24 | @sort{ℝ ⊆ Qℝ} 25 | @sort{ℝnz ⊆ Qℝnz}} 26 | 27 | We can also multiply or divide quantities by numbers: 28 | @inset{@op{ℝ × Q : Q} 29 | @op{ℝnz × Qnz : Qnz} 30 | @op{Q ÷ ℝnz : Q} 31 | @op{Qnz ÷ ℝnz : Qnz}} 32 | 33 | The simplification strategy is to reduce quantities to the form 34 | f × q, with q a non-reducible quantity, wherever possible. 35 | 36 | Combine multiple numerical prefactors into one: 37 | @inset{@rule{f1 × (f2 × q) ⇒ (f1 × f2) × q 38 | ∀ q:Q ∀ f1:ℝ ∀ f2:ℝ} 39 | @rule{f1 × ((f2 × q1) ÷ q2) ⇒ (f1 × f2) × (q1 ÷ q2) 40 | ∀ q1:Q ∀ q2:Q ∀ f1:ℝ ∀ f2:ℝ}} 41 | 42 | Replace division by multiplication: 43 | @inset{@rule{q ÷ f ⇒ (1 ÷ f) × q 44 | ∀ q:Q ∀ f:ℝnz} 45 | @rule{q1 ÷ (f × q2) ⇒ (1 ÷ f) × (q1 ÷ q2) 46 | ∀ q1:Q ∀ q2:Qnz ∀ f:ℝnz}} 47 | 48 | Remove quantities of zero magnitude from sums: 49 | @inset{@rule{q1 + (0 × q2) ⇒ q1 50 | ∀ q1:Q ∀ q2:Q} 51 | @rule{q1 - (0 × q2) ⇒ q1 52 | ∀ q1:Q ∀ q2:Q} 53 | @rule{(0 × q2) + q1 ⇒ q1 54 | ∀ q1:Q ∀ q2:Q} 55 | @rule{(0 × q2) - q1 ⇒ q1 56 | ∀ q1:Q ∀ q2:Q}} 57 | } 58 | 59 | @context["template" #:extend "quantities"]{ 60 | 61 | @section{A template for specific quantities} 62 | 63 | The definitions and rules for specific quantities such as mass or time 64 | are essentially the same. We define a template for a fictitious quantity 65 | @sort{SQ ⊆ Q} with @sort{SQnz ⊆ Qnz} and @sort{SQnz ⊆ SQ}, and 66 | derive the real physical quantities by name substitution. 67 | 68 | The sum and difference of two same-kind quantities is again a quantity 69 | of the same kind: 70 | @inset{@op{SQ + SQ : SQ} 71 | @op{SQ - SQ : SQ}} 72 | 73 | Multiplication and division by numbers also yields same-kind quantities: 74 | @inset{@op{ℝ × SQ : SQ} 75 | @op{ℝnz × SQnz : SQnz} 76 | @op{-(SQ) : SQ} 77 | @op{SQ ÷ SQnz : ℝ} 78 | @op{SQnz ÷ SQnz : ℝnz} 79 | @op{SQ ÷ ℝnz : SQ} 80 | @op{SQnz ÷ ℝnz : SQnz}} 81 | 82 | Finally, same-kind quantities can be compared: 83 | @inset{@op{SQ < SQ : boolean} 84 | @op{SQ > SQ : boolean} 85 | @op{SQ ≤ SQ : boolean} 86 | @op{SQ ≥ SQ : boolean}} 87 | 88 | In the simplification rules, we use the variables @var{sq:SQ}, @var{sq1:SQ}, 89 | @var{sq2:SQ} and @var{f:ℝ}, @var{f1:ℝ}, @var{f2:ℝ}. 90 | 91 | Combine sums and differences of the same @sort{SQ} with different numerical prefactors: 92 | @inset{@rule{(f1 × sq) + (f2 × sq) ⇒ (f1 + f2) × sq} 93 | @rule{(f1 × sq) - (f2 × sq) ⇒ (f1 - f2) × sq}} 94 | 95 | Reduce quotients of two @sort{SQ}s to a number: 96 | @inset{@rule{sq1 ÷ (f × sq2) ⇒ (sq1 ÷ f) ÷ sq2} 97 | @rule{(f × sq1) ÷ sq2 ⇒ f × (sq1 ÷ sq2)} 98 | @rule{sq ÷ sq ⇒ 1}} 99 | } 100 | 101 | @context["template-test" #:extend "template"]{ 102 | 103 | @subsection{Tests} 104 | 105 | Given two quantities @op{a : SQ} and @op{b : SQ} whose quotient we define 106 | as @rule{b ÷ a ⇒ 10}, we can test the simplification rules: 107 | 108 | @inset{@test{2 × (3 × a) ⇒ 6 × a} 109 | @test{2 × (a ÷ 3) ⇒ 2/3 × a} 110 | @test{(2 × a) ÷ (3 × a) ⇒ 2/3} 111 | @test{(2 × b) ÷ (3 × a) ⇒ 20/3} 112 | @test{(2 × a) + (3 × a) ⇒ 5 × a} 113 | @test{(2 × a) - (3 × a) ⇒ -1 × a}} 114 | 115 | } 116 | 117 | @context["mass" 118 | #:insert-use ["template" 119 | (rename-sort SQ M) 120 | (rename-sort SQnz Mnz)]]{ 121 | 122 | @section{Mass} 123 | 124 | Replace SQ by M and SQnz by Mnz in the template: 125 | 126 | @show-context["mass"] 127 | } 128 | 129 | 130 | @context["length" 131 | #:insert-use ["template" 132 | (rename-sort SQ L) 133 | (rename-sort SQnz Lnz)]]{ 134 | 135 | @section{Length} 136 | 137 | Replace SQ by L and SQnz by Lnz in the template: 138 | 139 | @show-context["length"] 140 | } 141 | 142 | 143 | @context["time" 144 | #:insert-use ["template" 145 | (rename-sort SQ T) 146 | (rename-sort SQnz Tnz)]]{ 147 | 148 | @section{Time} 149 | 150 | Replace SQ by T and SQnz by Tnz in the template (result now shown). 151 | 152 | } 153 | 154 | @context["velocity" 155 | #:insert-use ["template" 156 | (rename-sort SQ V) 157 | (rename-sort SQnz Vnz)]]{ 158 | 159 | @section{Velocity} 160 | 161 | Replace SQ by V and SQnz by Vnz in the template (result not shown). 162 | 163 | } 164 | 165 | @context["acceleration" 166 | #:insert-use ["template" 167 | (rename-sort SQ A) 168 | (rename-sort SQnz Anz)]]{ 169 | 170 | @section{Acceleration} 171 | 172 | Replace SQ by A and SQnz by Anz in the template (result not shown). 173 | 174 | } 175 | 176 | @context["force" 177 | #:insert-use ["template" 178 | (rename-sort SQ F) 179 | (rename-sort SQnz Fnz)]]{ 180 | 181 | @section{Force} 182 | 183 | Replace SQ by F and SQnz by Fnz in the template (result not shown). 184 | 185 | } 186 | 187 | @context["angle" 188 | #:insert-use ["template" 189 | (rename-sort SQ angle) 190 | (rename-sort SQnz angle-nz)]]{ 191 | 192 | @sort{angle} 193 | @op{π : angle} 194 | 195 | } 196 | 197 | @context["frequency" 198 | #:use "time" 199 | #:insert-use ["template" 200 | (rename-sort SQ frequency) 201 | (rename-sort SQnz frequency-nz)]]{ 202 | 203 | @op{frequency × T : ℝ} 204 | @op{frequency-nz × Tnz : ℝnz} 205 | @op{T × frequency : ℝ} 206 | @op{Tnz × frequency-nz : ℝnz} 207 | } 208 | 209 | @context["angular-frequency" 210 | #:use "time" 211 | #:use "angle" 212 | #:insert-use ["template" 213 | (rename-sort SQ angular-frequency) 214 | (rename-sort SQnz angular-frequency-nz)]]{ 215 | 216 | @op{angular-frequency × T : angle} 217 | @op{angular-frequency-nz × Tnz : angle-nz} 218 | @op{T × angular-frequency : angle} 219 | @op{Tnz × angular-frequency-nz : angle-nz} 220 | } 221 | 222 | @context["function-template" #:insert-use ["template" 223 | (rename-sort SQ SQD) 224 | (rename-sort SQnz SQDnz)] 225 | #:insert-use ["template" 226 | (rename-sort SQ SQI) 227 | (rename-sort SQnz SQInz)]]{ 228 | 229 | @section{A template for functions from one quantity to another} 230 | 231 | This template defines functions from a domain quantity @sort{SQD} to an 232 | image quantity @sort{SQI}. The sort for such functions is @sort{SQD→SQI ⊆ Q→Q}, 233 | function application is defined by @op{SQD→SQI[SQD] : SQI}. 234 | 235 | It is convenient to provide some arithmetic: 236 | @itemlist[#:style 'ordered 237 | @item{Addition and subtraction of functions: 238 | @itemlist[ 239 | @item{@op{f:SQD→SQI + g:SQD→SQI : SQD→SQI} with @linebreak[] 240 | @rule{(f + g)[x] ⇒ f[x] + g[x] ∀ x:SQD}} 241 | @item{@op{f:SQD→SQI - g:SQD→SQI : SQD→SQI} with @linebreak[] 242 | @rule{(f - g)[x] ⇒ f[x] - g[x] ∀ x:SQD}} 243 | ]} 244 | @item{Addition and subtraction of constants: 245 | @itemlist[ 246 | @item{@op{f:SQD→SQI + q:SQI : SQD→SQI} with @linebreak[] 247 | @rule{(f + q)[x] ⇒ f[x] + q ∀ x:SQD}} 248 | @item{@op{f:SQD→SQI - q:SQI : SQD→SQI} with @linebreak[] 249 | @rule{(f - q)[x] ⇒ f[x] + q ∀ x:SQD}} 250 | @item{@op{q:SQI + f:SQD→SQI : SQD→SQI} with @linebreak[] 251 | @rule{(q + f)[x] ⇒ q + f[x] ∀ x:SQD}} 252 | @item{@op{q:SQI - f:SQD→SQI : SQD→SQI} with @linebreak[] 253 | @rule{(q - f)[x] ⇒ q - f[x] ∀ x:SQD}} 254 | ]} 255 | @item{Multiplication with scalars: 256 | @itemlist[ 257 | @item{@op{s:ℝ × f:SQD→SQI : SQD→SQI} with @linebreak[] 258 | @rule{(s × f)[x] ⇒ s × f[x] ∀ x:SQD}} 259 | @item{@op{-(f:SQD→SQI) : SQD→SQI} with @linebreak[] 260 | @rule{-(f)[x] ⇒ -(f[x]) ∀ x:SQD}}]} 261 | ] 262 | } 263 | 264 | @context["function-with-derivative-template" 265 | #:insert-use ["function-template"] 266 | #:insert-use ["function-template" 267 | (rename-sort SQI SQID) 268 | (rename-sort SQInz SQIDnz) 269 | (rename-sort SQD→SQI SQD→SQID)]]{ 270 | 271 | @section{A template for functions with derivatives} 272 | 273 | The derivative of a function is given by @op{𝒟(SQD→SQI) : SQD→SQID}, 274 | where @sort{SQID ⊆ Qℝ} is the quotient of @sort{SQI} and @sort{SQD}. 275 | 276 | It is a linear operator, i.e. for @var{f:SQD→SQI}, @var{g:SQD→SQI}, 277 | and @var{s:ℝ} we have 278 | @inset{@rule{𝒟(f + g) ⇒ 𝒟(f) + 𝒟(g)} 279 | @rule{𝒟(f - g) ⇒ 𝒟(f) - 𝒟(g)} 280 | @rule{𝒟(s × f) ⇒ s × 𝒟(f)}} 281 | 282 | } 283 | 284 | @context["function-with-finite-difference-template" 285 | #:insert-extend["function-with-derivative-template"]]{ 286 | 287 | In numerical approximations, the derivative operator 288 | @op{𝒟(SQD→SQI) : SQD→SQID} is replaced by the finite-difference 289 | operator @op{Δ(f:SQD→SQI, h:SQDnz) : SQD→SQID}. A finite-difference 290 | approximation is characterized by a parameter @var{h:SQDnz}, assumed 291 | to be a sufficiently small quantity. 292 | 293 | Like the derivative operators, the finite-difference operator is linear, i.e. 294 | for two functions @var{f:SQD→SQI} and @var{g:SQD→SQI}, and a 295 | numerical scaling factor @var{s:ℝ}, we have 296 | @inset{@rule{Δ(f + g, h) ⇒ Δ(f, h) + Δ(g, h)} 297 | @rule{Δ(f - g, h) ⇒ Δ(f, h) - Δ(g, h)} 298 | @rule{Δ(s × f, h) ⇒ s × Δ(f, h)}} 299 | 300 | } 301 | 302 | 303 | @;signature-graphs["quantities.sig"] 304 | 305 | -------------------------------------------------------------------------------- /leibniz/condd.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ; http://jeapostrophe.github.io/2013-11-12-condd-post.html 4 | 5 | (provide condd) 6 | 7 | (require (for-syntax syntax/parse)) 8 | 9 | (define-syntax (condd stx) 10 | (syntax-parse stx 11 | [(_) 12 | #'(error 'condd "Fell through without else clause")] 13 | [(_ [else . e]) 14 | #'(let () . e)] 15 | [(_ #:do d . tail) 16 | #'(let () d (condd . tail))] 17 | [(_ [t:expr . e] . tail) 18 | #'(if t 19 | (let () . e) 20 | (condd . tail))])) 21 | -------------------------------------------------------------------------------- /leibniz/drracket-buttons.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | ; This code is taken from the Scribble pluging for DrRacket with minor 4 | ; modifications. I don't understand what all of this does in detail, so 5 | ; this is probably not optimal. 6 | 7 | (require racket/runtime-path 8 | racket/gui/base 9 | racket/class 10 | mrlib/bitmap-label 11 | racket/system 12 | net/sendurl 13 | drracket/tool-lib) 14 | 15 | (provide drracket-buttons) 16 | 17 | (module test racket/base) 18 | 19 | (define-runtime-path leibniz-png-path "leibniz-button.png") 20 | (define leibniz.png (make-object bitmap% leibniz-png-path 'png/mask)) 21 | 22 | (define-namespace-anchor anchor) 23 | 24 | (define original-error-display-handler (error-display-handler)) 25 | 26 | (define (make-render-button label bmp number) 27 | (list 28 | label 29 | bmp 30 | (λ (drs-frame) 31 | (define fn (send (send drs-frame get-definitions-text) get-filename)) 32 | (define html-fn (path-replace-suffix fn #".html")) 33 | (define xml-fn (path-replace-suffix fn #".xml")) 34 | (cond 35 | [fn 36 | (parameterize ([drracket:rep:after-expression 37 | (λ () 38 | (define scribble-doc 39 | (with-handlers ((exn:fail? (λ (x) #f))) (eval 'doc))) 40 | (define leibniz-doc 41 | (with-handlers ((exn:fail? (λ (x) #f))) (eval 'leibniz))) 42 | ;; if (eval 'doc) goes wrong, then we assume that's because of 43 | ;; an earlier failure, so we just don't do anything. 44 | (when scribble-doc 45 | (printf "leibniz: loading xref\n") 46 | (define xref ((dynamic-require 'setup/xref 'load-collections-xref))) 47 | (printf "leibniz: rendering\n") 48 | (parameterize ([current-input-port (open-input-string "")]) 49 | ((dynamic-require 'scribble/render 'render) 50 | (list scribble-doc) 51 | (list fn) 52 | #:render-mixin (dynamic-require 'scribble/html-render 53 | 'render-mixin) 54 | #:xrefs (list xref))) 55 | (send-url/file html-fn)) 56 | (when leibniz-doc 57 | (printf "leibniz: xml generation\n") 58 | ((dynamic-require 'leibniz/documents 'write-xml) 59 | leibniz-doc xml-fn)))]) 60 | (send drs-frame execute-callback))] 61 | [else 62 | (message-box "Leibniz" "Cannot render buffer without filename")])) 63 | number)) 64 | 65 | (define drracket-buttons 66 | (list (make-render-button "Leibniz" leibniz.png 99))) 67 | -------------------------------------------------------------------------------- /leibniz/equations.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (struct-out rule) 5 | (struct-out equation) 6 | (struct-out transformation) 7 | (contract-out 8 | [make-rule (signature? term? (or/c #f term?) (or/c term? procedure?) 9 | (or/c #f symbol?) boolean? 10 | . -> . rule?)] 11 | [valid-rule? (signature? any/c . -> . boolean?)] 12 | [rulelist? (any/c . -> . boolean?)] 13 | [empty-rulelist rulelist?] 14 | [in-rules (rulelist? . -> . stream?)] 15 | [add-rule (rulelist? rule? . -> . rulelist?)] 16 | [lookup-rules (rulelist? term? . -> . list?)] 17 | [merge-rulelists (rulelist? rulelist? signature? . -> . rulelist?)] 18 | [display-rule (rule? output-port? . -> . void?)] 19 | [rule-sorts-str (signature? rule? . -> . string?)] 20 | [make-equation (signature? term? (or/c #f term?) term? . -> . equation?)] 21 | [valid-equation? (signature? any/c . -> . boolean?)] 22 | [in-signature (rule? signature? . -> . rule?)] 23 | [display-equation (equation? output-port? . -> . void?)] 24 | [equation-sorts-str (signature? equation? . -> . string?)] 25 | [make-transformation (signature? rule? . -> . transformation?)] 26 | [transformation-sorts-str (signature? transformation? . -> . string?)])) 27 | 28 | (require "./sorts.rkt" 29 | "./operators.rkt" 30 | "./terms.rkt") 31 | 32 | (module+ test 33 | (require "./term-syntax.rkt" 34 | "./test-examples.rkt" 35 | rackunit 36 | racket/function 37 | threading)) 38 | 39 | ; 40 | ; Rules and equations 41 | ; 42 | 43 | (define (term-sort-or-kind signature term) 44 | (define sort (term.sort term)) 45 | (if (term.has-vars? term) 46 | (kind (signature-sort-graph signature) sort) 47 | sort)) 48 | 49 | (define (display-label label port) 50 | (when label 51 | (display "#:label " port) 52 | (write label port) 53 | (display #\space port))) 54 | 55 | (define (display-rule* rule port) 56 | (display-label (rule-label rule) port) 57 | (display-vars (term.vars (rule-pattern rule)) port) 58 | (display-term (rule-pattern rule) port) 59 | (display #\space port) 60 | (if (procedure? (rule-replacement rule)) 61 | (display-term "" port) 62 | (display-term (rule-replacement rule) port)) 63 | (when (rule-condition rule) 64 | (display " #:if " port) 65 | (display-term (rule-condition rule) port)) 66 | (display ")" port)) 67 | 68 | (define (display-rule rule port [mode #f]) 69 | (display "(=> " port) 70 | (display-rule* rule port)) 71 | 72 | (struct rule (pattern condition replacement label) 73 | #:transparent 74 | #:methods gen:custom-write 75 | [(define write-proc display-rule)]) 76 | 77 | (define (display-equation equation port [mode #f]) 78 | (display "(eq " port) 79 | (display-vars (set-union (term.vars (equation-left equation)) 80 | (term.vars (equation-right equation))) 81 | port) 82 | (display-term (equation-left equation) port) 83 | (display #\space port) 84 | (display-term (equation-right equation) port) 85 | (when (equation-condition equation) 86 | (display " #:if " port) 87 | (display-term (equation-condition equation) port)) 88 | (display ")" port)) 89 | 90 | (struct equation (left condition right) 91 | #:transparent 92 | #:methods gen:custom-write 93 | [(define write-proc display-equation)]) 94 | 95 | ; 96 | ; Construct rules and equations after checking arguments 97 | ; 98 | (define (check-term signature term) 99 | (unless (allowed-term? signature term) 100 | (error (format "Term ~s not allowed within signature" term)))) 101 | 102 | (define (check-label label) 103 | (when (and label 104 | (not (symbol? label))) 105 | (error (format "Rule label not a symbol: ~s" label)))) 106 | 107 | (define (is-boolean? sort-graph sort) 108 | ; Accept both boolean and Boolean until spelling rules have stabilized... 109 | (cond 110 | [(has-sort? sort-graph 'boolean) 111 | (conforms-to? sort-graph sort 'boolean)] 112 | [else 113 | (error "signature has no boolean sort")])) 114 | 115 | (define (check-condition signature condition allowed-vars) 116 | (when condition 117 | (define sort-graph (signature-sort-graph signature)) 118 | (define condition-vars (term.vars condition)) 119 | (check-term signature condition) 120 | (unless (conforms-to? sort-graph (term.sort condition) 'boolean) 121 | (error (format "Condition ~s not boolean" condition))) 122 | (unless (and (lookup-op signature 'true empty) 123 | (lookup-op signature 'false empty)) 124 | (error "signature does not contain true and false")) 125 | (unless (set-empty? 126 | (set-subtract condition-vars allowed-vars)) 127 | (error (format "Condition ~s contains variables that are not used elsewhere" condition))))) 128 | 129 | (define (make-rule signature pattern condition replacement label check-equationality?) 130 | (define sort-graph (signature-sort-graph signature)) 131 | (check-term signature pattern) 132 | (check-label label) 133 | (check-condition signature condition (term.vars pattern)) 134 | (unless (procedure? replacement) 135 | (check-term signature replacement) 136 | (define pattern-vars (term.vars pattern)) 137 | (define replacement-vars (term.vars replacement)) 138 | (when check-equationality? 139 | (unless (set-empty? 140 | (set-subtract replacement-vars pattern-vars)) 141 | (error (format "Term ~s contains variables that are not in the rule pattern" replacement))) 142 | (unless (conforms-to? sort-graph 143 | (term.sort replacement) 144 | (kind sort-graph (term.sort pattern))) 145 | (error (format "Term ~s must be of sort ~s" 146 | replacement (term.sort pattern)))))) 147 | (rule pattern condition replacement label)) 148 | 149 | (define (valid-rule? signature rule) 150 | (and (rule? rule) 151 | (valid-term? signature (rule-pattern rule)) 152 | (or (not (rule-condition rule)) 153 | (valid-term? signature (rule-condition rule))) 154 | (or (procedure? (rule-replacement rule)) 155 | (valid-term? signature (rule-replacement rule))) 156 | (or (not (rule-label rule)) 157 | (symbol? (rule-label rule))))) 158 | 159 | (define (rule-sorts-str signature rule) 160 | (define pattern-sort (term-sort-or-kind signature (rule-pattern rule))) 161 | (define replacement-sort (term-sort-or-kind signature (rule-replacement rule))) 162 | (string-append 163 | (constraint->string (signature-sort-graph signature) pattern-sort) 164 | " ⇒ " 165 | (constraint->string (signature-sort-graph signature) replacement-sort))) 166 | 167 | (module+ test 168 | (with-signature a-signature 169 | (check-equal? (make-rule a-signature (T IntVar) #f (T 2) #f #t) 170 | (rule (T IntVar) #f (T 2) #f)) 171 | (check-equal? (make-rule a-signature (T IntVar) (T true) (T 2) #f #t) 172 | (rule (T IntVar) (T true) (T 2) #f)) 173 | (check-true (valid-rule? a-signature (rule (T IntVar) #f (T 2) #f))) 174 | (check-true (valid-rule? a-signature (rule (T IntVar) (T true) (T 2) #f))) 175 | (check-equal? (rule-sorts-str a-signature 176 | (make-rule a-signature (T IntVar) #f (T 2) #f #t)) 177 | "[ℚ] ⇒ ℕnz") 178 | ; Term 'bar not allowed in signature 179 | (check-exn exn:fail? (thunk (make-rule a-signature 'bar #f (T 2) #f #t))) 180 | (check-exn exn:fail? (thunk (make-rule a-signature (T Avar) 'bar (T 2) #f #t))) 181 | (check-exn exn:fail? (thunk (make-rule a-signature (T IntVar) #f 'bar #f #t))) 182 | ; Condition not a boolean 183 | (check-exn exn:fail? (thunk (make-rule a-signature (T IntVar) (T 0) (T 2) #f #t))) 184 | ; Variable in condition but not in pattern 185 | (check-exn exn:fail? 186 | (thunk (make-rule a-signature (T IntVar) (T BoolVar) (T 2) #f #t))) 187 | ; Variable in replacement but not in pattern 188 | (check-exn exn:fail? 189 | (thunk (make-rule a-signature (T IntVar) #f (T BoolVar) #f #t))) 190 | ; Replacement doesn't match sort of pattern 191 | (check-exn exn:fail? 192 | (thunk (make-rule a-signature (T IntVar) #f (T (foo a-B)) #f #t))))) 193 | 194 | (define (make-equation signature left condition right) 195 | (define sort-graph (signature-sort-graph signature)) 196 | (check-term signature left) 197 | (check-term signature right) 198 | (check-condition signature condition 199 | (set-union (term.vars left) (term.vars right))) 200 | (define left-sort-or-kind (term-sort-or-kind signature left)) 201 | (define right-sort-or-kind (term-sort-or-kind signature right)) 202 | (unless (or (conforms-to? sort-graph left-sort-or-kind right-sort-or-kind) 203 | (conforms-to? sort-graph right-sort-or-kind left-sort-or-kind)) 204 | (error (format "Left and right terms have incompatible sorts:\n ~a\n ~a" 205 | left right))) 206 | (equation left condition right)) 207 | 208 | (define (valid-equation? signature equation) 209 | (and (equation? equation) 210 | (valid-term? signature (equation-left equation)) 211 | (valid-term? signature (equation-right equation)) 212 | (or (not (equation-condition equation)) 213 | (valid-term? signature (equation-condition equation))))) 214 | 215 | (define (equation-sorts-str signature equation) 216 | (define left-sort (term-sort-or-kind signature (equation-left equation))) 217 | (define right-sort (term-sort-or-kind signature (equation-right equation))) 218 | (string-append 219 | (constraint->string (signature-sort-graph signature) left-sort) 220 | " = " 221 | (constraint->string (signature-sort-graph signature) right-sort))) 222 | 223 | (module+ test 224 | (with-signature a-signature 225 | (check-equal? (make-equation a-signature (T IntVar) #f (T 2)) 226 | (equation (T IntVar) #f (T 2))) 227 | (check-equal? (make-equation a-signature (T IntVar) (T true) (T 2)) 228 | (equation (T IntVar) (T true) (T 2))) 229 | (check-true (valid-equation? a-signature (equation (T IntVar) #f (T 2)))) 230 | (check-true (valid-equation? a-signature (equation (T IntVar) (T true) (T 2)))) 231 | (check-equal? (equation-sorts-str a-signature 232 | (make-equation a-signature (T IntVar) #f (T 2))) 233 | "[ℚ] = ℕnz") 234 | ; Term 'bar not allowed in signature 235 | (check-exn exn:fail? (thunk (make-equation a-signature 'bar #f (T 2)))) 236 | (check-exn exn:fail? (thunk (make-equation a-signature (T Avar) 'bar (T 2)))) 237 | (check-exn exn:fail? (thunk (make-equation a-signature (T IntVar) #f 'bar))) 238 | ; Condition not a boolean 239 | (check-exn exn:fail? (thunk (make-equation a-signature (T IntVar) (T 0) (T 2)))) 240 | ; Variable in condition but not in either term 241 | (check-exn exn:fail? 242 | (thunk (make-equation a-signature (T IntVar) (T BoolVar) (T 2)))) 243 | ; Variable in replacement but not in either term 244 | (check-exn exn:fail? 245 | (thunk (make-equation a-signature (T IntVar) #f (T BoolVar)))) 246 | ; Term sorts do not match 247 | (check-exn exn:fail? 248 | (thunk (make-equation a-signature (T IntVar) #f (T (foo a-B))))))) 249 | 250 | ; Convert a rule to a new (larger) signature. Used for merging contexts. 251 | (define (in-signature rule signature) 252 | (make-rule signature 253 | (term.in-signature (rule-pattern rule) signature) 254 | (let ([c (rule-condition rule)]) 255 | (if c 256 | (term.in-signature c signature) 257 | c)) 258 | (let ([r (rule-replacement rule)]) 259 | (if (procedure? r) 260 | r 261 | (term.in-signature r signature))) 262 | (rule-label rule) 263 | #t)) 264 | 265 | (module+ test 266 | (define larger-signature 267 | (~> a-signature 268 | (add-op 'foo (list 'A) 'A))) 269 | (with-signature a-signature 270 | (check-true 271 | (valid-rule? larger-signature 272 | (in-signature (make-rule a-signature (T foo) #f (T foo) #f #t) 273 | larger-signature))) 274 | (check-true 275 | (valid-rule? larger-signature 276 | (in-signature (make-rule a-signature (T IntVar) #f (T 2) #f #t) 277 | larger-signature))))) 278 | 279 | ; 280 | ; Rule lists 281 | ; For efficiency, a rule list is organized as a hash of sublists, indexed 282 | ; by the key of its pattern. 283 | ; 284 | (define (rulelist? x) 285 | (hash? x)) 286 | 287 | (define empty-rulelist 288 | (hash)) 289 | 290 | (define (add-rule rulelist rule) 291 | (let* ([pattern (rule-pattern rule)] 292 | [key (term.key pattern)]) 293 | (hash-update rulelist 294 | key 295 | (λ (l) (append l (list rule))) 296 | empty))) 297 | 298 | (define (lookup-rules rulelist term) 299 | (hash-ref rulelist (term.key term) empty)) 300 | 301 | (define (in-rules rulelist) 302 | (for*/stream ([(key rules) rulelist] 303 | [rule rules]) 304 | rule)) 305 | 306 | (define (merge-rulelists rl1 rl2 merged-signature) 307 | (for/fold ([rules empty-rulelist]) 308 | ([rule (stream-append (in-rules rl1) (in-rules rl2))]) 309 | (add-rule rules (in-signature rule merged-signature)))) 310 | 311 | (module+ test 312 | (with-signature a-signature 313 | (define rule1 (make-rule a-signature (T IntVar) #f (T 2) #f #t)) 314 | (define rule2 (make-rule a-signature (T (foo Bvar)) #f (T Bvar) #f #t)) 315 | (define rule3 (make-rule a-signature (T (foo Avar Bvar)) #f (T (foo Bvar)) #f #t)) 316 | (define some-rules 317 | (~> empty-rulelist 318 | (add-rule rule1) 319 | (add-rule rule2) 320 | (add-rule rule3))) 321 | (check-equal? (hash-count some-rules) 2) 322 | (check-equal? (length (lookup-rules some-rules (T foo))) 2) 323 | (check-equal? (length (lookup-rules some-rules (T IntVar))) 1) 324 | (check-true (empty? (lookup-rules some-rules (T an-A)))) 325 | (check-equal? (stream-length (in-rules some-rules)) 3) 326 | (check-equal? (list->set (stream->list (in-rules some-rules))) 327 | (set rule1 rule2 rule3)) 328 | (check-equal? (merge-rulelists empty-rulelist some-rules a-signature) 329 | some-rules) 330 | (check-equal? (merge-rulelists some-rules empty-rulelist a-signature) 331 | some-rules))) 332 | 333 | ; 334 | ; Transformations are rewrite rules that are applied explicitly to 335 | ; arbitrary terms or equations, rather than being used in the process of 336 | ; context-based reduction. 337 | ; 338 | ; Since transformations can be applied to patterns containing variables, 339 | ; their own variables are replaced to gensym-based variables to avoid 340 | ; accidental name clashes. 341 | ; 342 | (define (display-transformation tr port [mode #f]) 343 | (display "(tr " port) 344 | (display-rule* (transformation-rule tr) port)) 345 | 346 | (struct transformation (rule converted-rule) 347 | #:transparent 348 | #:methods gen:custom-write 349 | [(define write-proc display-transformation)] 350 | #:methods gen:equal+hash 351 | [(define (equal-proc t1 t2 _) 352 | (equal? (transformation-rule t1) (transformation-rule t2))) 353 | (define (hash-proc t _) 354 | (equal-hash-code (transformation-rule t))) 355 | (define (hash2-proc t _) 356 | (equal-secondary-hash-code (transformation-rule t)))]) 357 | 358 | (define (make-transformation signature rule) 359 | (define sorts (signature-sort-graph signature)) 360 | (define pattern (rule-pattern rule)) 361 | (define condition (rule-condition rule)) 362 | (define replacement (rule-replacement rule)) 363 | (define var-substitution 364 | (for/fold ([s empty-substitution]) 365 | ([var (term.vars pattern)]) 366 | (merge-substitutions 367 | s 368 | (one-match signature var 369 | (make-unique-var sorts (var-name var) (var-sort var)))))) 370 | (transformation 371 | rule 372 | (make-rule signature 373 | (term.substitute signature pattern var-substitution) 374 | (if condition 375 | (term.substitute signature condition var-substitution) 376 | #f) 377 | (term.substitute signature replacement var-substitution) 378 | #f 379 | #f))) 380 | 381 | (define (transformation-sorts-str signature transformation) 382 | (define rule (transformation-rule transformation)) 383 | (define pattern-sort (term-sort-or-kind signature (rule-pattern rule))) 384 | (define replacement-sort (term-sort-or-kind signature (rule-replacement rule))) 385 | (string-append 386 | (constraint->string (signature-sort-graph signature) pattern-sort) 387 | " → " 388 | (constraint->string (signature-sort-graph signature) replacement-sort))) 389 | -------------------------------------------------------------------------------- /leibniz/images/IEEE-floating-point/sorts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/leibniz/images/IEEE-floating-point/sorts.png -------------------------------------------------------------------------------- /leibniz/images/integers/sorts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/leibniz/images/integers/sorts.png -------------------------------------------------------------------------------- /leibniz/images/rational-numbers/sorts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/leibniz/images/rational-numbers/sorts.png -------------------------------------------------------------------------------- /leibniz/images/real-numbers/sorts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/leibniz/images/real-numbers/sorts.png -------------------------------------------------------------------------------- /leibniz/images/truth/sorts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/leibniz/images/truth/sorts.png -------------------------------------------------------------------------------- /leibniz/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define collection "leibniz") 3 | (define deps '("at-exp-lib" 4 | "base" 5 | "chk" 6 | "drracket" 7 | "functional-lib" 8 | "gui-lib" 9 | "megaparsack" 10 | "net-lib" 11 | "rackunit-lib" 12 | "scribble-lib" 13 | "sxml" 14 | "threading")) 15 | (define build-deps '("racket-doc" 16 | "scribble-doc")) 17 | (define pkg-desc "Leibniz - A Digital Scientific Notation") 18 | (define version "0.2") 19 | 20 | (define racket-launcher-names '("leibniz")) 21 | (define racket-launcher-libraries '("run.rkt")) 22 | 23 | (define scribblings '(("leibniz.scrbl" (multi-page)))) 24 | -------------------------------------------------------------------------------- /leibniz/lang.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide empty-document 4 | (rename-out [cs:context context] 5 | [cs:import import] 6 | [cs:sort sort] 7 | [cs:var var] 8 | [cs:op op] 9 | [cs:term term] 10 | [cs:rule rule] 11 | [cs:equation equation] 12 | [cs:transformation transformation] 13 | [cs:comment-sort comment-sort] 14 | [cs:comment-op comment-op] 15 | [cs:test test] 16 | [cs:eval-term eval-term] 17 | [cs:ref ref] 18 | [cs:substitute substitute] 19 | [cs:transform transform] 20 | [cs:show-context show-context]) 21 | inset 22 | html view xml signature-graphs 23 | use show reduce matching-rules trace trans subs 24 | current-context 25 | (all-from-out scribble/base 26 | scribble/doclang)) 27 | 28 | (require (except-in scribble/doclang sort) 29 | scribble/base 30 | (only-in scribble/render render) 31 | browser/external 32 | (for-syntax syntax/parse) 33 | (prefix-in cs: "./context-syntax.rkt") 34 | "./documents.rkt" 35 | "./parser.rkt" 36 | "./formatting.rkt" 37 | (only-in megaparsack/text parse-string) 38 | (only-in megaparsack parse-result! parse-error->string) 39 | data/either 40 | threading 41 | (prefix-in operators: "./operators.rkt") 42 | (prefix-in terms: "./terms.rkt") 43 | (prefix-in equations: "./equations.rkt") 44 | (prefix-in rewrite: "./rewrite.rkt")) 45 | 46 | ;; 47 | ;; Support code for nicer formatting 48 | ;; 49 | (define (inset . body) 50 | (apply nested 51 | (for/list ([element body]) 52 | (if (equal? element "\n") 53 | (linebreak) 54 | element)) 55 | #:style 'inset)) 56 | 57 | ;; 58 | ;;; Generate HTML and XML output (not needed with the leibniz script) 59 | ;; 60 | (define-syntax (html stx) 61 | (let* ([doc-ref (datum->syntax stx 'doc)]) 62 | (syntax-parse stx 63 | [(_ filename:str) 64 | #`(render (list #,doc-ref) (list filename))]))) 65 | 66 | (define-syntax (view stx) 67 | (let* ([doc-ref (datum->syntax stx 'doc)]) 68 | (syntax-parse stx 69 | [(_ filename:str) 70 | #`(begin (render (list #,doc-ref) (list filename)) 71 | (send-url (format "file://~a" (path->string (path->complete-path filename)))))]))) 72 | 73 | (define-syntax (xml stx) 74 | (let* ([leibniz-ref (datum->syntax stx 'leibniz)]) 75 | (syntax-parse stx 76 | [(_ filename:str) 77 | #`(begin (write-xml #,leibniz-ref filename) 78 | (margin-note (hyperlink filename "XML")))]))) 79 | 80 | ;; 81 | ;; Graphviz output (for debugging) 82 | ;; 83 | (define-syntax (signature-graphs stx) 84 | (let* ([leibniz-ref (datum->syntax stx 'leibniz)]) 85 | (syntax-parse stx 86 | [(_ directory:str) 87 | #`(write-signature-graphs #,leibniz-ref directory)]))) 88 | 89 | ;; 90 | ;; Support for interactive exploration 91 | ;; REPL commands for use after loading a Leibniz module 92 | ;; 93 | (define current-context-name (make-parameter #f)) 94 | (define current-context (make-parameter #f)) 95 | (define current-document (make-parameter #f)) 96 | 97 | (define-syntax (use stx) 98 | (let* ([leibniz-ref (datum->syntax stx 'leibniz)]) 99 | (syntax-parse stx 100 | [(_ context-name:str) 101 | #`(begin 102 | (define context 103 | (with-handlers ([exn:fail? (λ (e) #f)]) 104 | (get-context #,leibniz-ref context-name))) 105 | (unless context 106 | (error (format "Undefined context ~a" context-name))) 107 | (current-document #,leibniz-ref) 108 | (current-context-name context-name) 109 | (current-context context))]))) 110 | 111 | (define (assert-current-context) 112 | (unless (current-context-name) 113 | (error "No context has been selected"))) 114 | 115 | (define (parse-term term-str) 116 | (parse-string (to-eof/p term/p) term-str)) 117 | 118 | (define (parse-equation eq-str) 119 | (parse-string equation/p eq-str)) 120 | 121 | (define (parse-transformation tr-str) 122 | (parse-string transformation/p tr-str)) 123 | 124 | (define (make-parsed-term term-str) 125 | (match (parse-term term-str) 126 | [(success parsed-term) 127 | (make-term (current-document) (current-context-name) parsed-term #f)] 128 | [(failure message) 129 | #f])) 130 | 131 | (define (make-parsed-term-or-eq str) 132 | (match (parse-equation str) 133 | [(success parsed-eq) 134 | (displayln parsed-eq) 135 | (make-equation (current-document) (current-context-name) parsed-eq #f)] 136 | [(failure message) 137 | (make-parsed-term str)])) 138 | 139 | (define (make-parsed-transformation transformation-str) 140 | (make-transformation (current-document) (current-context-name) 141 | (~> transformation-str 142 | parse-transformation 143 | parse-result!) 144 | #f)) 145 | 146 | (define (display-term signature term) 147 | (when term 148 | (displayln (format "~a : ~a" 149 | (terms:term.sort term) 150 | (plain-text (format-term signature #f term)))))) 151 | 152 | (define (display-equation signature equation) 153 | (when equation 154 | (displayln (plain-text (format-equation #f equation signature))))) 155 | 156 | (define (display-rule signature rule) 157 | (when rule 158 | (displayln (plain-text (format-rule #f rule signature))))) 159 | 160 | (define (show term-str) 161 | (assert-current-context) 162 | (define signature (hash-ref (current-context) 'compiled-signature)) 163 | (define term (make-parsed-term term-str)) 164 | (display-term signature term)) 165 | 166 | (define (reduce term-str) 167 | (assert-current-context) 168 | (define signature (hash-ref (current-context) 'compiled-signature)) 169 | (define rules (hash-ref (current-context) 'compiled-rules)) 170 | (define term (make-parsed-term term-str)) 171 | (define rterm (and term 172 | (rewrite:reduce signature rules term))) 173 | (display-term signature rterm)) 174 | 175 | (define (matching-rules term-str) 176 | (assert-current-context) 177 | (define signature (hash-ref (current-context) 'compiled-signature)) 178 | (define rules (hash-ref (current-context) 'compiled-rules)) 179 | (define term (make-parsed-term term-str)) 180 | (define matching (and term 181 | (rewrite:all-matching-rules signature rules term #f))) 182 | (for ([rule-with-substitution matching]) 183 | (display-rule signature (car rule-with-substitution)))) 184 | 185 | (define (trace term-str 186 | #:max-level [max-level 0] 187 | #:show-rules [show-rules #f]) 188 | (assert-current-context) 189 | (define (display-trace level term rule rterm) 190 | (cond 191 | [(equal? level 0) 192 | (when show-rules 193 | (displayln (format "--- ~a" 194 | (plain-text (format-rule #f rule signature))))) 195 | (displayln (format "... ~a" 196 | (plain-text (format-term signature #f rterm))))] 197 | [(or (not max-level) 198 | (<= level max-level)) 199 | (when show-rules 200 | (displayln (format "~a ~a" 201 | (make-string (+ level 3) #\-) 202 | (plain-text (format-rule #f rule signature))))) 203 | (displayln (format "~a ~a ⇒ ~a" 204 | (make-string (+ level 3) #\+) 205 | (plain-text (format-term signature #f term)) 206 | (plain-text (format-term signature #f rterm))))])) 207 | (define signature (hash-ref (current-context) 'compiled-signature)) 208 | (define rules (hash-ref (current-context) 'compiled-rules)) 209 | (define term (make-parsed-term term-str)) 210 | (when term 211 | (rewrite:trace-reduce signature rules term display-trace)) 212 | (void)) 213 | 214 | (define (trans term-or-eq-str transformation-str) 215 | (define signature (hash-ref (current-context) 'compiled-signature)) 216 | (define sort-graph (operators:signature-sort-graph signature)) 217 | (define term-or-eq (make-parsed-term-or-eq term-or-eq-str)) 218 | (define transformation (make-parsed-transformation transformation-str)) 219 | (cond 220 | [(terms:term? term-or-eq) 221 | (display-term signature 222 | (rewrite:transform signature transformation term-or-eq))] 223 | [(equations:equation? term-or-eq) 224 | (display-equation signature 225 | (rewrite:transform-equation signature transformation term-or-eq))])) 226 | 227 | (define (subs term-or-eq-str transformation-str) 228 | (define signature (hash-ref (current-context) 'compiled-signature)) 229 | (define sort-graph (operators:signature-sort-graph signature)) 230 | (define term-or-eq (make-parsed-term-or-eq term-or-eq-str)) 231 | (define transformation (make-parsed-transformation transformation-str)) 232 | (cond 233 | [(terms:term? term-or-eq) 234 | (display-term signature 235 | (rewrite:substitute signature transformation term-or-eq))] 236 | [(equations:equation? term-or-eq) 237 | (display-equation signature 238 | (rewrite:substitute-equation signature transformation term-or-eq))])) 239 | -------------------------------------------------------------------------------- /leibniz/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | 3 | leibniz/lang 4 | 5 | #:read read-inside 6 | #:read-syntax read-syntax-inside 7 | #:whole-body-readers? #t 8 | #:wrapper1 (lambda (t) (list* 'doc 'values '() '(define leibniz empty-document) '(provide leibniz) (t))) 9 | #:language-info (scribble-base-language-info) 10 | #:info (leibniz-info) 11 | 12 | (require scribble/reader 13 | (only-in scribble/base/reader 14 | scribble-base-info 15 | scribble-base-language-info)) 16 | 17 | (define (leibniz-info) 18 | (lambda (key defval default) 19 | (case key 20 | [(drracket:toolbar-buttons) 21 | (dynamic-require 'leibniz/drracket-buttons 'drracket-buttons) 22 | ; (list (make-render-button "Scribble HTML" html.png "--html" #".html" 99)) 23 | ] 24 | [else ((scribble-base-info) key defval default)]))) 25 | 26 | -------------------------------------------------------------------------------- /leibniz/leibniz-button.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/leibniz/leibniz-button.png -------------------------------------------------------------------------------- /leibniz/lightweight-class.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide define-class send) 4 | 5 | ; Define a very lightweight class. A class definition generates an 6 | ; equivalent transparent struct plus a function corresponding to 7 | ; each method. Inside the methods, fields can be accessed by name, 8 | ; rather than having to use the lengthy field accessor functions 9 | ; defined by Racket. 10 | 11 | (require (for-syntax racket/syntax 12 | syntax/parse 13 | syntax/stx) 14 | racket/splicing 15 | racket/generic) 16 | 17 | ;; (define-syntax-parameter send #f) 18 | (define-generics lightweight-object 19 | (send-msg lightweight-object method-symbol . args)) 20 | 21 | (define-syntax-rule (send object method-symbol arg ...) 22 | (send-msg object (quote method-symbol) arg ...)) 23 | 24 | (define-syntax (define-class stx) 25 | (syntax-parse stx 26 | [(_ class-name:id 27 | ((~literal field) field-name:id ...) 28 | (~optional (~seq #:write-proc my-write-proc:expr)) 29 | ((~literal define) 30 | (method-name:id method-arg:id ...) body:expr ...) ...) 31 | (with-syntax* ([obj-arg 32 | (generate-temporary #'class-name)] 33 | [((temp-arg ...) ...) 34 | (stx-map generate-temporaries #'((method-arg ...) ...))] 35 | [(accessor ...) 36 | (stx-map (λ (x) (format-id #'class-name 37 | "~a-~a" #'class-name x)) 38 | #'(field-name ...))] 39 | [this (datum->syntax stx 'this)] 40 | [(ext-method-name ...) 41 | (generate-temporaries #'(method-name ...))]) 42 | (let ([custom-write-impl 43 | (if (attribute my-write-proc) 44 | #'(#:methods gen:custom-write 45 | [(define write-proc my-write-proc)]) 46 | #'())]) 47 | #`(begin 48 | (define (method-name obj-arg temp-arg ...) 49 | (let ([this obj-arg] 50 | [field-name (accessor obj-arg)] ...) 51 | (let ([ext-method-name method-name] ...) 52 | (let ([method-name (λ (method-arg ...) 53 | (method-name obj-arg method-arg ...))] 54 | ...) 55 | (let ([method-arg temp-arg] ...) 56 | body ...))))) 57 | ... 58 | (struct class-name [field-name ...] #:transparent 59 | #:methods gen:lightweight-object 60 | [(define (send-msg object symbol . args) 61 | (apply (case symbol 62 | [(method-name) method-name] ...) 63 | (list* object args)))] 64 | #,@custom-write-impl))))])) 65 | 66 | (module* test #f 67 | (require rackunit) 68 | 69 | (define-class foo 70 | (field a b) 71 | #:write-proc *write* 72 | (define (bar x) 73 | (* a b x)) 74 | (define (baz) 75 | (bar 1)) 76 | (define (get) 77 | this) 78 | (define (get-a) 79 | a) 80 | (define (id1 a) 81 | a) 82 | (define (id2 this) 83 | this) 84 | (define (add-as other) 85 | (+ a (send other get-a))) 86 | (define (*write* p w) 87 | (write-string (format "" a b) p))) 88 | 89 | 90 | (define a-foo (foo 2 3)) 91 | (define another-foo (foo 10 20)) 92 | (check-equal? (bar a-foo 42) 252) 93 | (check-equal? (baz a-foo) 6) 94 | (check-eq? (get a-foo) a-foo) 95 | (check-eq? (get-a a-foo) 2) 96 | (check-eq? (send a-foo get-a) 2) 97 | (check-eq? (id1 a-foo 42) 42) 98 | (check-eq? (id2 a-foo 42) 42) 99 | (check-eq? (add-as a-foo another-foo) 100 | (+ (get-a a-foo) (get-a another-foo)))) 101 | -------------------------------------------------------------------------------- /leibniz/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | -------------------------------------------------------------------------------- /leibniz/rewrite-syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide with-rules rules 4 | R T RT A S eq tr) 5 | 6 | (require "./signature-syntax.rkt" 7 | "./terms.rkt" 8 | "./equations.rkt" 9 | (prefix-in rs: "./rule-syntax.rkt") 10 | (only-in "./rule-syntax.rkt" T eq tr) 11 | "./rewrite.rkt" 12 | threading 13 | racket/stxparam 14 | (for-syntax syntax/parse 15 | racket/stxparam)) 16 | 17 | (module+ test 18 | (require chk) 19 | (define test-signature 20 | (signature 21 | (sort boolean) 22 | (op true boolean) 23 | (op false boolean) 24 | (op (not boolean) boolean) 25 | (op foo boolean) 26 | (op bar boolean))) 27 | (define test-rules 28 | (rules test-signature 29 | (=> (not true) false) 30 | (=> (not false) true) 31 | (=> foo (not true) #:if false) 32 | (=> foo (not false) #:if true)))) 33 | 34 | (define (reduce-anything signature rules x) 35 | (cond 36 | [(term? x) 37 | (reduce signature rules x)] 38 | [(equation? x) 39 | (reduce-equation signature rules x)] 40 | [else 41 | (error (format "cannot reduce ~s" x))])) 42 | 43 | (define (transform-anything signature tr x) 44 | (cond 45 | [(term? x) 46 | (transform signature tr x)] 47 | [(equation? x) 48 | (transform-equation signature tr x)] 49 | [else 50 | (error (format "cannot transform ~s" x))])) 51 | 52 | (define (substitute-anything signature tr x) 53 | (cond 54 | [(term? x) 55 | (substitute signature tr x)] 56 | [(equation? x) 57 | (substitute-equation signature tr x)] 58 | [else 59 | (error (format "cannot substitute ~s" x))])) 60 | 61 | (define-syntax-parameter R 62 | (λ (stx) 63 | (raise-syntax-error 'R "R keyword used outside with-rules" stx))) 64 | 65 | (define-syntax-parameter RT 66 | (λ (stx) 67 | (raise-syntax-error 'RT "RT keyword used outside with-rules" stx))) 68 | 69 | (define-syntax-parameter A 70 | (λ (stx) 71 | (raise-syntax-error 'A "A keyword used outside with-rules" stx))) 72 | 73 | (define-syntax-parameter S 74 | (λ (stx) 75 | (raise-syntax-error 'S "S keyword used outside with-rules" stx))) 76 | 77 | (begin-for-syntax 78 | 79 | (define-splicing-syntax-class opt-label 80 | #:description "optional label in a rule" 81 | (pattern (~seq #:label a-symbol:id) 82 | #:with expr #'(quote a-symbol)) 83 | (pattern (~seq) 84 | #:with expr #'#f)) 85 | 86 | (define-splicing-syntax-class opt-vars 87 | #:description "optional variable declaration in a rule" 88 | (pattern (~seq #:vars ([var-name:id var-sort:id] ...)) 89 | #:with expr #'(list (cons (quote var-name) 90 | (quote var-sort)) ...)) 91 | (pattern (~seq #:var [var-name:id var-sort:id]) 92 | #:with expr #'(list (cons (quote var-name) 93 | (quote var-sort)))) 94 | ; a more mathematics-like variant 95 | (pattern (~seq (~seq (~datum ∀) var-name:id (~datum :) var-sort:id) ...) 96 | #:with expr #'(list (cons (quote var-name) 97 | (quote var-sort)) ...)) 98 | ; two variants of the former with parentheses for use with sweet-exp 99 | (pattern (~seq ((~seq (~datum ∀) var-name:id (~datum :) var-sort:id)) ...) 100 | #:with expr #'(list (cons (quote var-name) 101 | (quote var-sort)) ...)) 102 | (pattern (~seq (~seq (~datum ∀) var-name-1:id (~datum :) var-sort-1:id) 103 | ((~seq (~datum ∀) var-name:id (~datum :) var-sort:id)) ...) 104 | #:with expr #'(list (cons (quote var-name-1) 105 | (quote var-sort-1)) 106 | (cons (quote var-name) 107 | (quote var-sort)) ...)) 108 | (pattern (~seq) 109 | #:with expr #'empty)) 110 | 111 | (define-splicing-syntax-class (embedded-pattern sig var) 112 | #:description "embedded pattern in a rule" 113 | (pattern p:expr 114 | #:with expr #`(rs:pattern #,sig #,var p))) 115 | 116 | (define-splicing-syntax-class (opt-condition sig vars) 117 | #:description "optional condition in a rule" 118 | (pattern (~seq #:if (~var condition (embedded-pattern sig vars))) 119 | #:with expr #'condition.expr) 120 | (pattern (~seq) 121 | #:with expr #'#f)) 122 | 123 | (define-splicing-syntax-class (rule-hp sig vars) 124 | (pattern (~seq a-label:opt-label 125 | local-vars:opt-vars 126 | (~var pattern (embedded-pattern sig vars)) 127 | (~var replacement (embedded-pattern sig vars)) 128 | (~var condition (opt-condition sig vars))) 129 | #:with args #`(list #,sig pattern.expr condition.expr 130 | replacement.expr a-label.expr) 131 | #:with vars #'local-vars.expr)) 132 | 133 | (define-syntax-class (pattern-rule sig vars) 134 | #:description "pattern rule declaration" 135 | (pattern ((~datum =>) 136 | (~var prhp (rule-hp sig vars))) 137 | #:with expr #`(apply make-rule (append prhp.args '(#t))) 138 | #:with vars #'prhp.vars)) 139 | 140 | (define-syntax-class (fn-rule sig vars) 141 | #:description "function rule declaration" 142 | (pattern ((~datum ->) 143 | a-label:opt-label 144 | local-vars:opt-vars 145 | (~var pattern (embedded-pattern sig vars)) 146 | replacement:expr 147 | (~var condition (opt-condition sig vars))) 148 | #:with expr #`(make-rule #,sig pattern.expr condition.expr 149 | replacement a-label.expr #f) 150 | #:with vars #'local-vars.expr)) 151 | 152 | (define-syntax-class (equation sig vars) 153 | #:description "equation declaration" 154 | (pattern ((~datum eq) 155 | local-vars:opt-vars 156 | (~var left (embedded-pattern sig vars)) 157 | (~var right (embedded-pattern sig vars)) 158 | (~var condition (opt-condition sig vars))) 159 | #:with expr #`(make-equation #,sig left.expr condition.expr 160 | right.expr) 161 | #:with vars #'local-vars.expr)) 162 | (define-syntax-class (rule sig vars) 163 | #:description "rule declaration" 164 | (pattern (~var pr (pattern-rule sig vars)) 165 | #:with expr #'pr.expr 166 | #:with vars #'pr.vars) 167 | (pattern (~var fr (fn-rule sig vars)) 168 | #:with expr #'fr.expr 169 | #:with vars #'fr.vars))) 170 | 171 | (define (local-vars vars var-defs) 172 | (foldl (λ (vd vs) (hash-set vs (car vd) (cdr vd))) vars var-defs)) 173 | 174 | (define-syntax (rules stx) 175 | (syntax-parse stx 176 | [(_ signature 177 | (~var rule-defs (rule #'signature #'vars*)) ...) 178 | #`(~> empty-rulelist 179 | (add-rule 180 | (let ([vars* (local-vars (hash) rule-defs.vars)]) 181 | rule-defs.expr)) 182 | ...)])) 183 | 184 | (define-syntax (with-rules stx) 185 | (syntax-parse stx 186 | [(_ signature:expr rules:expr body:expr ...) 187 | #'(syntax-parameterize 188 | ([eq (λ (stx) 189 | (syntax-parse stx 190 | [(~var eqn (equation #'signature 191 | #'vars*)) 192 | #'(let ([vars* (local-vars (hash) eqn.vars)]) 193 | eqn.expr)]))] 194 | [tr (λ (stx) 195 | (syntax-parse stx 196 | [(_ (~var pr (rule-hp #'signature 197 | #'vars*))) 198 | #'(let ([vars* (local-vars (hash) pr.vars)]) 199 | (make-transformation 200 | signature 201 | (apply make-rule (append pr.args '(#f)))))]))] 202 | [R (λ (stx) 203 | (syntax-parse stx 204 | [(_ arg:expr) 205 | #'(reduce-anything signature rules arg)]))] 206 | [RT (λ (stx) 207 | (syntax-parse stx 208 | [(_ term) 209 | #'(reduce signature rules (T term))]))] 210 | [A (λ (stx) 211 | (syntax-parse stx 212 | [(_ tr:expr arg:expr) 213 | #'(transform-anything signature tr arg)]))] 214 | [S (λ (stx) 215 | (syntax-parse stx 216 | [(_ tr:expr arg:expr) 217 | #'(substitute-anything signature tr arg)]))]) 218 | (rs:with-signature signature 219 | body ...))])) 220 | 221 | (module+ test 222 | (with-rules test-signature test-rules 223 | (chk 224 | #:= (RT (not true)) (T false) 225 | #:= (RT (not false)) (T true) 226 | #:= (RT (not (not false))) (T false) 227 | #:= (R (T foo)) (T true) 228 | #:= (R (eq foo true)) (eq true true) 229 | #:= (R (eq foo true)) 230 | (eq true true) 231 | #:= (R (eq foo true)) 232 | (eq true true) 233 | #:= (A (tr #:var (X boolean) X (not X)) (T bar)) 234 | (T (not bar)) 235 | #:= (A (tr #:var (X boolean) X (not X)) (T foo)) 236 | (T (not foo)) 237 | #:= (A (tr #:var (X boolean) X (not X)) (eq bar foo)) 238 | (eq (not bar) (not foo)) 239 | #:= (A (tr #:var (X boolean) X (not X)) (eq bar foo)) 240 | (eq (not bar) (not foo)) 241 | #:= (S (tr bar (not bar)) 242 | (T (not bar))) 243 | (T (not (not bar))) 244 | #:= (S (tr foo (not foo)) 245 | (T (not foo))) 246 | (T (not (not foo))) 247 | #:= (S (tr foo (not bar)) 248 | (eq foo bar)) 249 | (eq (not bar) bar)))) 250 | -------------------------------------------------------------------------------- /leibniz/rule-syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide rules with-signature eq tr 4 | [rename-out [ts:T T] 5 | [ts:term term] 6 | [ts:pattern pattern]]) 7 | 8 | (require "./equations.rkt" 9 | (prefix-in ts: "./term-syntax.rkt") 10 | threading 11 | racket/stxparam 12 | (for-syntax syntax/parse 13 | racket/stxparam)) 14 | 15 | (module+ test 16 | (require rackunit)) 17 | 18 | (begin-for-syntax 19 | 20 | (define-splicing-syntax-class opt-label 21 | #:description "optional label in a rule" 22 | (pattern (~seq #:label a-symbol:id) 23 | #:with expr #'(quote a-symbol)) 24 | (pattern (~seq) 25 | #:with expr #'#f)) 26 | 27 | (define-splicing-syntax-class opt-vars 28 | #:description "optional variable declaration in a rule" 29 | (pattern (~seq #:vars ([var-name:id var-sort:id] ...)) 30 | #:with expr #'(list (cons (quote var-name) 31 | (quote var-sort)) ...)) 32 | (pattern (~seq #:var [var-name:id var-sort:id]) 33 | #:with expr #'(list (cons (quote var-name) 34 | (quote var-sort)))) 35 | ; a more mathematics-like variant 36 | (pattern (~seq (~seq (~datum ∀) var-name:id (~datum :) var-sort:id) ...) 37 | #:with expr #'(list (cons (quote var-name) 38 | (quote var-sort)) ...)) 39 | ; two variants of the former with parentheses for use with sweet-exp 40 | (pattern (~seq ((~seq (~datum ∀) var-name:id (~datum :) var-sort:id)) ...) 41 | #:with expr #'(list (cons (quote var-name) 42 | (quote var-sort)) ...)) 43 | (pattern (~seq (~seq (~datum ∀) var-name-1:id (~datum :) var-sort-1:id) 44 | ((~seq (~datum ∀) var-name:id (~datum :) var-sort:id)) ...) 45 | #:with expr #'(list (cons (quote var-name-1) 46 | (quote var-sort-1)) 47 | (cons (quote var-name) 48 | (quote var-sort)) ...)) 49 | (pattern (~seq) 50 | #:with expr #'empty)) 51 | 52 | (define-splicing-syntax-class (embedded-pattern sig var) 53 | #:description "embedded pattern in a rule" 54 | (pattern p:expr 55 | #:with expr #`(ts:pattern #,sig #,var p))) 56 | 57 | (define-splicing-syntax-class (opt-condition sig vars) 58 | #:description "optional condition in a rule" 59 | (pattern (~seq #:if (~var condition (embedded-pattern sig vars))) 60 | #:with expr #'condition.expr) 61 | (pattern (~seq) 62 | #:with expr #'#f)) 63 | 64 | (define-splicing-syntax-class (rule-hp sig vars) 65 | (pattern (~seq a-label:opt-label 66 | local-vars:opt-vars 67 | (~var pattern (embedded-pattern sig vars)) 68 | (~var replacement (embedded-pattern sig vars)) 69 | (~var condition (opt-condition sig vars))) 70 | #:with args #`(list #,sig pattern.expr condition.expr 71 | replacement.expr a-label.expr) 72 | #:with vars #'local-vars.expr)) 73 | 74 | (define-syntax-class (pattern-rule sig vars) 75 | #:description "pattern rule declaration" 76 | (pattern ((~datum =>) 77 | (~var prhp (rule-hp sig vars))) 78 | #:with expr #`(apply make-rule (append prhp.args '(#t))) 79 | #:with vars #'prhp.vars)) 80 | 81 | (define-syntax-class (fn-rule sig vars) 82 | #:description "function rule declaration" 83 | (pattern ((~datum ->) 84 | a-label:opt-label 85 | local-vars:opt-vars 86 | (~var pattern (embedded-pattern sig vars)) 87 | replacement:expr 88 | (~var condition (opt-condition sig vars))) 89 | #:with expr #`(make-rule #,sig pattern.expr condition.expr 90 | replacement a-label.expr #f) 91 | #:with vars #'local-vars.expr)) 92 | 93 | (define-syntax-class (equation sig vars) 94 | #:description "equation declaration" 95 | (pattern ((~datum eq) 96 | local-vars:opt-vars 97 | (~var left (embedded-pattern sig vars)) 98 | (~var right (embedded-pattern sig vars)) 99 | (~var condition (opt-condition sig vars))) 100 | #:with expr #`(make-equation #,sig left.expr condition.expr 101 | right.expr) 102 | #:with vars #'local-vars.expr)) 103 | (define-syntax-class (rule sig vars) 104 | #:description "rule declaration" 105 | (pattern (~var pr (pattern-rule sig vars)) 106 | #:with expr #'pr.expr 107 | #:with vars #'pr.vars) 108 | (pattern (~var fr (fn-rule sig vars)) 109 | #:with expr #'fr.expr 110 | #:with vars #'fr.vars))) 111 | 112 | (define (local-vars vars var-defs) 113 | (foldl (λ (vd vs) (hash-set vs (car vd) (cdr vd))) 114 | vars 115 | var-defs)) 116 | 117 | (define-syntax (rules stx) 118 | (syntax-parse stx 119 | [(_ signature 120 | (~var rule-defs (rule #'signature #'vars*)) ...) 121 | #`(~> empty-rulelist 122 | (add-rule 123 | (let ([vars* (local-vars (hash) rule-defs.vars)]) 124 | rule-defs.expr)) 125 | ...)])) 126 | 127 | (define-syntax-parameter eq 128 | (λ (stx) 129 | (raise-syntax-error 'eq "eq keyword used outside with-signature" stx))) 130 | 131 | (define-syntax-parameter tr 132 | (λ (stx) 133 | (raise-syntax-error 'tr "tr keyword used outside with-signature" stx))) 134 | 135 | (define-syntax (with-signature stx) 136 | (syntax-parse stx 137 | [(_ signature:expr body:expr ...) 138 | #'(syntax-parameterize 139 | ([eq (λ (stx) 140 | (syntax-parse stx 141 | [(~var eqn (equation #'signature 142 | #'vars*)) 143 | #'(let ([vars* (local-vars (hash) eqn.vars)]) 144 | eqn.expr)]))] 145 | [tr (λ (stx) 146 | (syntax-parse stx 147 | [(_ (~var pr (rule-hp #'signature 148 | #'vars*))) 149 | #'(let ([vars* (local-vars (hash) pr.vars)]) 150 | (make-transformation 151 | signature 152 | (apply make-rule (append pr.args '(#f)))))]))]) 153 | (ts:with-signature signature 154 | body ...))])) 155 | -------------------------------------------------------------------------------- /leibniz/run.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/cmdline 4 | (only-in scribble/render render) 5 | (only-in leibniz/documents write-xml)) 6 | 7 | (define (run) 8 | (command-line 9 | #:args (filename) 10 | (define doc (dynamic-require `(file ,filename) 'doc)) 11 | (define leibniz (dynamic-require `(file ,filename) 'leibniz)) 12 | (define-values (base name dir?) (split-path filename)) 13 | (define xml-filename (path-replace-extension filename #".xml")) 14 | (render (list doc) (list name)) 15 | (write-xml leibniz xml-filename))) 16 | 17 | (module+ test) 18 | 19 | (module+ main 20 | (run)) 21 | -------------------------------------------------------------------------------- /leibniz/signature-syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide signature) 4 | 5 | (require "./sorts.rkt" 6 | "./operators.rkt" 7 | threading 8 | racket/stxparam 9 | (for-syntax syntax/parse 10 | racket/stxparam)) 11 | 12 | (module+ test 13 | (require rackunit 14 | "./builtins.rkt" 15 | "./test-examples.rkt")) 16 | 17 | (begin-for-syntax 18 | 19 | (define-syntax-class include 20 | #:description "include declaration" 21 | (pattern ((~datum include) signature:expr))) 22 | 23 | (define-syntax-class sort-or-subsort 24 | #:description "sort or subsort declaration" 25 | (pattern ((~datum sort) sort-name:id) 26 | #:with value 27 | #'(add-sort (quote sort-name))) 28 | (pattern ((~datum subsort) sort1:id sort2:id) 29 | #:with value 30 | #'(add-subsort-relation (quote sort1) (quote sort2)))) 31 | 32 | (define-syntax-class operator 33 | #:description "operator declaration" 34 | (pattern ((~datum op) op-name:id sort:id) 35 | #:with value 36 | #'(add-op (quote op-name) empty (quote sort))) 37 | (pattern ((~datum op) (op-name:id arg-sort:id ...) sort:id) 38 | #:with value 39 | #'(add-op (quote op-name) 40 | (list (quote arg-sort) ...) 41 | (quote sort)))) 42 | 43 | (define-syntax-class variable 44 | #:description "variable declaration" 45 | (pattern ((~datum var) var-name:id sort:id) 46 | #:with value 47 | #'(add-var (quote var-name) (quote sort))))) 48 | 49 | (define-syntax (signature stx) 50 | (syntax-parse stx 51 | [(_ inclusions:include ... 52 | sort-defs:sort-or-subsort ... 53 | op-defs:operator ... 54 | var-defs:variable ...) 55 | #`(let ([sorts (~> (for/fold ([ms empty-sort-graph]) 56 | ([s (list (signature-sort-graph 57 | inclusions.signature) ...)]) 58 | (merge-sort-graphs ms s)) 59 | sort-defs.value ...)]) 60 | (~> (for/fold ([msig (empty-signature sorts)]) 61 | ([sig (list inclusions.signature ...)]) 62 | (merge-signatures msig sig sorts)) 63 | op-defs.value ... 64 | var-defs.value ...))])) 65 | 66 | (module+ test 67 | (define sig 68 | (signature 69 | (include truth-signature) 70 | (include rational-signature) 71 | (sort A) 72 | (sort B) 73 | (subsort B A) 74 | (sort X) 75 | (sort Y) 76 | (subsort Y X) 77 | (op an-A A) 78 | (op a-B B) 79 | (op an-X X) 80 | (op a-Y Y) 81 | (op foo B) 82 | (op (foo B) A) 83 | (op (foo A B) A) 84 | (var Avar A) 85 | (var Bvar B) 86 | (var IntVar ℤ) 87 | (var BoolVar boolean))) 88 | (check-equal? sig a-signature)) 89 | -------------------------------------------------------------------------------- /leibniz/sorts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (rename-out [is-sort-graph? sort-graph?]) 5 | (contract-out 6 | [empty-sort-graph sort-graph?] 7 | [validate-sort (sort-graph? symbol? . -> . void?)] 8 | [add-sort (sort-graph? symbol? . -> . sort-graph?)] 9 | [add-subsort-relation (sort-graph? symbol? symbol? . -> . sort-graph?)] 10 | [merge-sort-graphs (sort-graph? sort-graph? . -> . sort-graph?)] 11 | [optimize-subsort-lookup (sort-graph? . -> . sort-graph?)] 12 | [all-sorts (sort-graph? . -> . set?)] 13 | [all-subsort-relations (sort-graph? . -> . set?)] 14 | [all-subsorts (sort-graph? sort? . -> . set?)] 15 | [has-multiple-supersorts? (sort-graph? sort? . -> . boolean?)] 16 | [has-sort? (sort-graph? symbol? . -> . boolean?)] 17 | [is-subsort? (sort-graph? symbol? symbol? . -> . boolean?)] 18 | [kind (sort-graph? sort-or-kind? . -> . set?)] 19 | [has-kind? (sort-graph? set? . -> . boolean?)] 20 | [maximal-sorts (sort-graph? set? . -> . set?)] 21 | [sort? (any/c . -> . boolean?)] 22 | [kind? (any/c . -> . boolean?)] 23 | [sort-or-kind? (any/c . -> . boolean?)] 24 | [sort-constraint? (any/c . -> . boolean?)] 25 | [valid-sort-constraint? (sort-graph? any/c . -> . boolean?)] 26 | [validate-sort-constraint (sort-graph? sort-constraint? . -> . void?)] 27 | [kind-constraint (sort-graph? sort-constraint? 28 | . -> . sort-constraint?)] 29 | [conforms-to? (sort-graph? sort-constraint? sort-constraint? 30 | . -> . boolean?)] 31 | [conforming-sorts (sort-graph? sort-constraint? . -> . set?)] 32 | [constraint->string (sort-graph? sort-constraint? . -> . string?)] 33 | [connected-components (sort-graph? . -> . (listof sort-graph?))] 34 | [display-sort-graph (sort-graph? natural-number/c output-port? 35 | . -> . void?)])) 36 | 37 | (require "./lightweight-class.rkt") 38 | 39 | (module+ test 40 | (require rackunit racket/function threading)) 41 | 42 | ; 43 | ; Sorts and kinds 44 | ; 45 | ; A sort is nothing but a label, represented by a Racket symbol. A 46 | ; sort can be declared a subsort of other sorts. The subsort relations 47 | ; define a partial order on sorts and form a directed acyclic graph 48 | ; (DAG). Each connected component of this graph defines a kind. Sorts 49 | ; that belong to different kinds are completely unrelated. Kinds 50 | ; matter because operator definitions are subject to constraints on 51 | ; their argument sorts if there are multiple definitions for sorts in 52 | ; the same kind. Kinds are represented as sets of the sorts they contain, 53 | ; i.e. as sets of symbols. 54 | ; 55 | ; Sort and kind constraints are used in operator and variable definitions. 56 | ; They limit the sorts which can be used in certain places. There are three 57 | ; types of sort constraints: 58 | ; - #f stands for no constraint 59 | ; - a sort allows itself and any of its subsorts 60 | ; - a kind allows any sort that belongs to it 61 | ; 62 | 63 | ; Sort graphs 64 | ; 65 | (define-class sort-graph 66 | 67 | (field kinds supersorts subsorts subsort-cache) 68 | ; kinds: a hash mapping sorts to their kinds, each kind being a set of sorts 69 | ; supersorts: a hash mapping sorts to their immediate supersorts 70 | ; subsorts: a hash mapping sorts to their immediate subsorts 71 | ; subsort-cache: #f or a hash mapping sorts tp a set of all their 72 | ; subsorts, immediate and indirect. 73 | ; 74 | ; The information in supersorts and subsorts is identical (a 75 | ; directed graph); each hash can be created from the other. The set 76 | ; of kinds can also be computed from the subsort relations. All 77 | ; three are stored explicitly for more efficient lookup. 78 | 79 | #:write-proc *display* 80 | 81 | (define (has-sort? sort) 82 | (hash-has-key? subsorts sort)) 83 | 84 | (define (is-subsort? sort1 sort2) 85 | (cond 86 | [subsort-cache 87 | (set-member? (hash-ref subsort-cache sort2) sort1)] 88 | [else 89 | (validate-sort sort1) 90 | (validate-sort sort2) 91 | (or (equal? sort1 sort2) 92 | (let ([ss (hash-ref subsorts sort2)]) 93 | (or (set-member? ss sort1) 94 | (for/or ([s (in-set ss)]) 95 | (is-subsort? sort1 s)))))])) 96 | 97 | (define (validate-sort sort) 98 | (unless (has-sort? sort) 99 | (error "undefined sort" sort))) 100 | 101 | (define (add-sort new-sort) 102 | (unless (symbol? new-sort) 103 | (error "not a valid sort:" new-sort)) 104 | (if (has-sort? new-sort) 105 | this 106 | (sort-graph (hash-set kinds new-sort (set new-sort)) 107 | (hash-set supersorts new-sort (set)) 108 | (hash-set subsorts new-sort (set)) 109 | #f))) 110 | 111 | (define (add-subsort-relation subsort supersort) 112 | (validate-sort subsort) 113 | (validate-sort supersort) 114 | (if (equal? subsort supersort) 115 | this ; don't record a sort as its own subsort 116 | (begin 117 | (when (is-subsort? supersort subsort) 118 | (error "cycle in subsort relation:" supersort subsort)) 119 | (sort-graph (let ([new-kind (set-union (hash-ref kinds supersort) 120 | (hash-ref kinds subsort))]) 121 | (for/fold ([kinds kinds]) 122 | ([sort (in-set new-kind)]) 123 | (hash-set kinds sort new-kind))) 124 | (hash-update supersorts subsort 125 | (λ (s) (set-add s supersort))) 126 | (hash-update subsorts supersort 127 | (λ (s) (set-add s subsort))) 128 | #f)))) 129 | 130 | (define (merge-sort-graphs s-graph) 131 | (let ([sg 132 | (for/fold ([sg this]) 133 | ([sort (send s-graph all-sorts)]) 134 | (send sg add-sort sort))]) 135 | (for/fold ([sg sg]) 136 | ([ss-relation (send s-graph all-subsort-relations)]) 137 | (send sg add-subsort-relation (car ss-relation) (cdr ss-relation))))) 138 | 139 | (define (optimize-subsort-lookup) 140 | (define (full-subsort-set acc sort) 141 | (cond 142 | [(hash-has-key? acc sort) acc] 143 | [else 144 | (define i-ss (hash-ref subsorts sort)) 145 | (for/fold ([acc (hash-set acc sort (set-add i-ss sort))]) 146 | ([s (in-set i-ss)]) 147 | (define new-acc (full-subsort-set acc s)) 148 | (hash-update new-acc sort 149 | (λ (ss) (set-union ss (hash-ref new-acc s)))))])) 150 | (cond 151 | [subsort-cache 152 | this] 153 | [else 154 | (define cache 155 | (for/fold ([acc (hash)]) 156 | ([sort (hash-keys subsorts)]) 157 | (full-subsort-set acc sort))) 158 | (sort-graph kinds supersorts subsorts cache)])) 159 | 160 | (define (all-sorts) 161 | (list->set (hash-keys subsorts))) 162 | 163 | (define (all-subsort-relations) 164 | (list->set 165 | (apply append 166 | (hash-map supersorts 167 | (λ (s1 ss) (for/list ([s2 (in-set ss)]) 168 | (cons s1 s2))))))) 169 | 170 | (define (all-subsorts sort) 171 | (cond 172 | [subsort-cache 173 | (hash-ref subsort-cache sort)] 174 | [else 175 | (define ss (hash-ref subsorts sort)) 176 | (for/fold ([ss ss]) 177 | ([s ss]) 178 | (set-union ss (all-subsorts s)))])) 179 | 180 | (define (has-multiple-supersorts? sort) 181 | (> (set-count (hash-ref supersorts sort (set))) 1)) 182 | 183 | (define (kind sort-or-kind) 184 | (if (sort? sort-or-kind) 185 | (begin 186 | (validate-sort sort-or-kind) 187 | (hash-ref kinds sort-or-kind)) 188 | sort-or-kind)) 189 | 190 | (define (has-kind? x) 191 | (and (set? x) 192 | (not (set-empty? x)) 193 | (has-sort? (set-first x)) 194 | (equal? x (kind (set-first x))))) 195 | 196 | (define (maximal-sorts kind) 197 | (for/set ([s (in-set kind)] 198 | #:when (set-empty? (hash-ref supersorts s))) 199 | s)) 200 | 201 | (define (valid-sort-constraint? constraint) 202 | (cond 203 | [(equal? #f constraint) 204 | #t] 205 | [(symbol? constraint) 206 | (has-sort? constraint)] 207 | [(set? constraint) 208 | (has-kind? constraint)] 209 | [else #f])) 210 | 211 | (define (validate-sort-constraint constraint) 212 | (unless (valid-sort-constraint? constraint) 213 | (error "invalid sort constraint" constraint))) 214 | 215 | (define (kind-constraint constraint) 216 | (validate-sort-constraint constraint) 217 | (cond 218 | [(equal? #f constraint) #f] 219 | [(symbol? constraint) (kind constraint)] 220 | [else constraint])) 221 | 222 | (define (conforms-to? c1 c2) 223 | (validate-sort-constraint c1) 224 | (validate-sort-constraint c2) 225 | (cond 226 | [(equal? c2 #f) 227 | #t] 228 | [(equal? c1 #f) 229 | #f] 230 | [(set? c1) 231 | (equal? c1 (conforming-sorts c2))] 232 | [(symbol? c2) 233 | (is-subsort? c1 c2)] 234 | [else 235 | (set-member? c2 c1)])) 236 | 237 | (define (conforming-sorts constraint) 238 | (cond 239 | [(equal? constraint #f) 240 | (all-sorts)] 241 | [(symbol? constraint) 242 | (set-add (all-subsorts constraint) constraint)] 243 | [else ; kind 244 | constraint])) 245 | 246 | (define (constraint->string constraint) 247 | (validate-sort-constraint constraint) 248 | (cond 249 | [(equal? constraint #f) 250 | "[*]"] 251 | [(symbol? constraint) 252 | (symbol->string constraint)] 253 | [else 254 | (format "[~a]" 255 | (string-join (map symbol->string 256 | (set->list (maximal-sorts constraint))) 257 | ","))])) 258 | 259 | (define (connected-components) 260 | (define components (list->set (hash-values kinds))) 261 | (if (equal? (set-count components) 1) 262 | (list this) 263 | (for/list ([k components]) 264 | (sort-graph (for/hash ([s k]) (values s k)) 265 | (for/hash ([s k]) (values s (hash-ref supersorts s))) 266 | (for/hash ([s k]) (values s (hash-ref subsorts s))) 267 | #f)))) 268 | 269 | (define (display-sort-graph indentation port) 270 | (define prefix (make-string indentation #\space)) 271 | (for ([cc (connected-components)]) 272 | (define k (send cc all-sorts)) 273 | (newline port) 274 | (display prefix port) 275 | (display "; kind " port) 276 | (display (constraint->string k) port) 277 | (newline port) 278 | (display prefix port) 279 | (display "(sorts" port) 280 | (for ([sort (in-set k)]) 281 | (display #\space port) 282 | (display sort port)) 283 | (display ")\n" port) 284 | (display prefix port) 285 | (display "(subsorts" port) 286 | (for ([ss (in-set (send cc all-subsort-relations))]) 287 | (display " [" port) 288 | (display (car ss) port) 289 | (display " " port) 290 | (display (cdr ss) port) 291 | (display "]" port)) 292 | (display ")" port))) 293 | 294 | (define (*display* port mode) 295 | (display "(sort-graph" port) 296 | (display-sort-graph 2 port) 297 | (display ")\n" port))) 298 | 299 | (define empty-sort-graph 300 | (sort-graph (hash) (hash) (hash) #f)) 301 | 302 | (define (is-sort-graph? x) 303 | (sort-graph? x)) 304 | 305 | ; 306 | ; Tests for sorts and sort constraints 307 | ; 308 | (define (sort? x) 309 | (symbol? x)) 310 | 311 | (define (kind? x) 312 | (and (set? x) 313 | (not (set-empty? x)) 314 | (for/and ([e x]) 315 | (sort? e)))) 316 | 317 | (define (sort-or-kind? x) 318 | (or (sort? x) 319 | (kind? x))) 320 | 321 | (define (sort-constraint? x) 322 | (or (equal? x #f) 323 | (sort-or-kind? x))) 324 | 325 | ; 326 | ; Unit tests 327 | ; 328 | (module+ test 329 | (define an-s-graph 330 | (~> empty-sort-graph 331 | (add-sort 'A) (add-sort 'B) 332 | (add-sort 'C) (add-sort 'D) 333 | (add-subsort-relation 'A 'B) (add-subsort-relation 'B 'C) 334 | (add-subsort-relation 'A 'D))) 335 | (define another-s-graph 336 | (~> empty-sort-graph 337 | (add-sort 'A) 338 | (add-sort 'X) (add-sort 'Y) 339 | (add-subsort-relation 'A 'X) 340 | (add-subsort-relation 'X 'Y))) 341 | (define merged (merge-sort-graphs an-s-graph another-s-graph)) 342 | (define two-kinds 343 | (~> an-s-graph 344 | (add-sort 'V) (add-sort 'W) 345 | (add-subsort-relation 'V 'W))) 346 | 347 | (check-equal? an-s-graph (add-sort an-s-graph 'A)) 348 | 349 | (check-true (has-sort? an-s-graph 'A)) 350 | (check-true (has-sort? an-s-graph 'B)) 351 | (check-true (has-sort? an-s-graph 'C)) 352 | (check-true (has-sort? an-s-graph 'D)) 353 | (check-false (has-sort? an-s-graph 'X)) 354 | (check-equal? (all-sorts an-s-graph) 355 | (set 'A 'B 'C 'D)) 356 | 357 | (check-true (is-subsort? an-s-graph 'A 'A)) 358 | (check-true (is-subsort? an-s-graph 'A 'B)) 359 | (check-true (is-subsort? an-s-graph 'B 'C)) 360 | (check-true (is-subsort? an-s-graph 'A 'C)) 361 | (check-true (is-subsort? an-s-graph 'A 'D)) 362 | (check-false (is-subsort? an-s-graph 'C 'A)) 363 | (check-equal? (all-subsort-relations an-s-graph) 364 | (set '(A . B) '(A . D) '(B . C))) 365 | 366 | (check-equal? (all-subsorts an-s-graph 'B) (set 'A)) 367 | (check-equal? (all-subsorts an-s-graph 'C) (set 'A 'B)) 368 | (check-equal? (all-subsorts merged 'Y) (set 'A 'X)) 369 | (check-equal? (all-subsorts two-kinds 'W) (set 'V)) 370 | 371 | (check-exn exn:fail? (thunk (add-sort an-s-graph #t))) 372 | (check-exn exn:fail? (thunk (add-subsort-relation an-s-graph 'A 'X))) 373 | (check-exn exn:fail? (thunk (add-subsort-relation an-s-graph 'X 'A))) 374 | (check-exn exn:fail? (thunk (add-subsort-relation an-s-graph 'C 'A))) 375 | 376 | (check-equal? merged 377 | (merge-sort-graphs another-s-graph an-s-graph)) 378 | (check-true (has-sort? merged 'A)) 379 | (check-true (has-sort? merged 'X)) 380 | (check-true (is-subsort? merged 'A 'X )) 381 | (check-true (is-subsort? merged 'A 'C )) 382 | (check-equal? (merge-sort-graphs an-s-graph an-s-graph) an-s-graph) 383 | (check-equal? (merge-sort-graphs empty-sort-graph an-s-graph) an-s-graph) 384 | (check-equal? (merge-sort-graphs an-s-graph empty-sort-graph) an-s-graph) 385 | (check-equal? (kind two-kinds 'A) (kind two-kinds 'C)) 386 | (check-equal? (kind two-kinds 'V) (kind two-kinds 'W)) 387 | (check-not-equal? (kind two-kinds 'A) (kind two-kinds 'W)) 388 | 389 | (check-true (has-kind? two-kinds (kind two-kinds 'A))) 390 | (check-false (has-kind? two-kinds #f)) 391 | (check-false (has-kind? two-kinds (set))) 392 | (check-false (has-kind? two-kinds (set 'X))) 393 | (check-false (has-kind? two-kinds (set 'A))) 394 | 395 | (check-equal? (kind-constraint two-kinds 'A) 396 | (kind two-kinds 'A)) 397 | (check-equal? (kind-constraint two-kinds (kind two-kinds 'A)) 398 | (kind two-kinds 'A)) 399 | 400 | (check-true (conforms-to? two-kinds 'A 'B)) 401 | (check-true (conforms-to? two-kinds 'W 'W)) 402 | (check-true (conforms-to? two-kinds 'A #f)) 403 | (check-true (conforms-to? two-kinds 'V #f)) 404 | (check-true (conforms-to? two-kinds 'A (kind two-kinds 'B))) 405 | (check-true (conforms-to? two-kinds 'V (kind two-kinds 'W))) 406 | (check-false (conforms-to? two-kinds 'V (kind two-kinds 'A))) 407 | (check-false (conforms-to? two-kinds 'A 'V)) 408 | (check-true (conforms-to? two-kinds (kind two-kinds 'A) (kind two-kinds 'B))) 409 | (check-false (conforms-to? two-kinds (kind two-kinds 'A) (kind two-kinds 'W))) 410 | 411 | (check-equal? (conforming-sorts two-kinds 'B) 412 | (set 'A 'B)) 413 | (check-equal? (conforming-sorts two-kinds (kind two-kinds 'B)) 414 | (set 'A 'B 'C 'D)) 415 | (check-equal? (conforming-sorts two-kinds #f) 416 | (set 'A 'B 'C 'D 'V 'W)) 417 | 418 | (check-equal? (constraint->string two-kinds 'A) "A") 419 | (check-equal? (constraint->string two-kinds 'V) "V") 420 | (check-equal? (constraint->string two-kinds (kind two-kinds 'V)) "[W]") 421 | (check-equal? (constraint->string two-kinds #f) "[*]") 422 | 423 | (check-equal? (connected-components an-s-graph) 424 | (list an-s-graph)) 425 | (check-equal? (connected-components another-s-graph) 426 | (list another-s-graph)) 427 | (check-equal? (connected-components merged) 428 | (list merged)) 429 | (check-equal? (list->set (connected-components two-kinds)) 430 | (set an-s-graph 431 | (~> empty-sort-graph 432 | (add-sort 'V) (add-sort 'W) 433 | (add-subsort-relation 'V 'W)))) 434 | 435 | (check-equal? (~> an-s-graph 436 | (optimize-subsort-lookup) 437 | (sort-graph-subsort-cache)) 438 | (hash 'A (set 'A) 439 | 'B (set 'A 'B) 440 | 'C (set 'A 'B 'C) 441 | 'D (set 'A 'D))) 442 | (check-equal? (~> merged 443 | (optimize-subsort-lookup) 444 | (sort-graph-subsort-cache)) 445 | (hash 'A (set 'A) 446 | 'B (set 'A 'B) 447 | 'C (set 'A 'B 'C) 448 | 'D (set 'A 'D) 449 | 'X (set 'A 'X) 450 | 'Y (set 'A 'X 'Y))) 451 | (check-equal? (~> two-kinds 452 | (optimize-subsort-lookup) 453 | (sort-graph-subsort-cache)) 454 | (hash 'A (set 'A) 455 | 'B (set 'A 'B) 456 | 'C (set 'A 'B 'C) 457 | 'D (set 'A 'D) 458 | 'V (set 'V) 459 | 'W (set 'V 'W)))) 460 | -------------------------------------------------------------------------------- /leibniz/term-syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide term pattern with-signature T) 4 | 5 | (require "./terms.rkt" 6 | "./operators.rkt" 7 | racket/stxparam 8 | (for-syntax syntax/parse 9 | racket/stxparam)) 10 | 11 | (module+ test 12 | (require "./test-examples.rkt" 13 | rackunit 14 | racket/function)) 15 | 16 | ; 17 | ; Validation for atomic terms. op-terms are validated by make-term. 18 | ; 19 | (define (validate-atomic signature value) 20 | (if (allowed-term? signature value) 21 | value 22 | (error (format "~s: builtin term type ~s not allowed by signature" 23 | value (term.builtin-type value))))) 24 | 25 | ; 26 | ; Basic term construction syntax 27 | ; 28 | (begin-for-syntax 29 | 30 | (define-syntax-class (atom sig-var) 31 | #:description "atomic term" 32 | #:attributes (value) 33 | (pattern s:str #:with value #`(validate-atomic #,sig-var s)) 34 | (pattern ((~literal quote) symbol:id) 35 | #:with value #`(validate-atomic #,sig-var (quote symbol))) 36 | (pattern x:number 37 | #:with value #`(validate-atomic #,sig-var x))) 38 | 39 | (define-syntax-class (term sig-var) 40 | #:description "term" 41 | #:attributes (value) 42 | (pattern (~var a (atom sig-var)) #:with value #'a.value) 43 | (pattern symbol:id 44 | #:with value 45 | #`(make-term #,sig-var (quote symbol) empty)) 46 | (pattern (symbol:id (~var arg-terms (term sig-var)) ...) 47 | #:with value 48 | #`(make-term #,sig-var (quote symbol) 49 | (list arg-terms.value ...)))) 50 | 51 | (define-splicing-syntax-class opt-vars 52 | #:description "optional variable declaration in a rule or equation" 53 | (pattern (~seq #:vars ([var-name:id var-sort:id] ...)) 54 | #:with expr #'(list (cons (quote var-name) 55 | (quote var-sort)) ...)) 56 | (pattern (~seq #:var [var-name:id var-sort:id]) 57 | #:with expr #'(list (cons (quote var-name) 58 | (quote var-sort)))) 59 | ; a more mathematics-like variant 60 | (pattern (~seq (~seq (~datum ∀) var-name:id (~datum :) var-sort:id) ...) 61 | #:with expr #'(list (cons (quote var-name) 62 | (quote var-sort)) ...)) 63 | ; two variants of the former with parentheses for use with sweet-exp 64 | (pattern (~seq ((~seq (~datum ∀) var-name:id (~datum :) var-sort:id)) ...) 65 | #:with expr #'(list (cons (quote var-name) 66 | (quote var-sort)) ...)) 67 | (pattern (~seq (~seq (~datum ∀) var-name-1:id (~datum :) var-sort-1:id) 68 | ((~seq (~datum ∀) var-name:id (~datum :) var-sort:id)) ...) 69 | #:with expr #'(list (cons (quote var-name-1) 70 | (quote var-sort-1)) 71 | (cons (quote var-name) 72 | (quote var-sort)) ...)) 73 | (pattern (~seq) 74 | #:with expr #'empty)) 75 | 76 | (define-syntax-class (term-pattern sig-var vars-var) 77 | #:description "pattern" 78 | #:attributes (value) 79 | (pattern (~var a (atom sig-var)) #:with value #'a.value) 80 | (pattern symbol:id 81 | #:with value 82 | #`(make-var-or-term #,sig-var (quote symbol) #,vars-var)) 83 | (pattern (symbol:id (~var arg-terms (term-pattern sig-var vars-var)) ...) 84 | #:with value 85 | #`(make-term #,sig-var (quote symbol) 86 | (list arg-terms.value ...))))) 87 | 88 | (define-syntax (term stx) 89 | (syntax-parse stx 90 | [(_ signature:expr (~var t (term #'sig))) 91 | #'(let ([sig signature]) 92 | t.value)])) 93 | 94 | (define (local-vars vars var-defs) 95 | (foldl (λ (vd vs) (hash-set vs (car vd) (cdr vd))) vars var-defs)) 96 | 97 | (define-syntax (pattern stx) 98 | (syntax-parse stx 99 | [(_ signature:expr lvars ov:opt-vars 100 | (~var p (term-pattern #'sig #'vars))) 101 | #'(let ([sig signature] 102 | [vars (local-vars lvars ov.expr)]) 103 | p.value)])) 104 | 105 | (module+ test 106 | (check-equal? (term a-signature 2) 2) 107 | (check-equal? (term a-signature an-A) 108 | (make-term a-signature 'an-A empty)) 109 | (check-equal? (term a-signature (foo a-B)) 110 | (make-term a-signature 'foo 111 | (list (make-term a-signature 'a-B empty)))) 112 | (check-equal? (term a-signature (foo (foo a-B) a-B)) 113 | (let* ([a-B (make-term a-signature 'a-B empty)] 114 | [foo-a-B (make-term a-signature 'foo (list a-B))]) 115 | (make-term a-signature 'foo (list foo-a-B a-B)))) 116 | (check-exn exn:fail? (thunk (term a-signature 'foo))) 117 | (check-exn exn:fail? (thunk (term a-signature "foo"))) 118 | (check-equal? (pattern a-signature (hash) Avar) 119 | (make-var a-signature 'Avar)) 120 | (check-equal? (pattern a-signature (hash) #:var (Xvar ℤ) Xvar) 121 | (make-var a-signature 'Xvar (hash 'Xvar 'ℤ))) 122 | (check-equal? (pattern a-signature (hash) (foo Bvar)) 123 | (make-term a-signature 'foo 124 | (list (make-var a-signature 'Bvar))))) 125 | 126 | ; 127 | ; with-signature 128 | ; 129 | (define-syntax-parameter T 130 | (λ (stx) 131 | (raise-syntax-error 'T "T keyword used outside with-signature" stx))) 132 | 133 | (define-syntax (with-signature stx) 134 | (syntax-parse stx 135 | [(_ signature:expr body:expr ...) 136 | #'(let ([sig signature]) 137 | (syntax-parameterize 138 | ([T (λ (stx) 139 | (syntax-parse stx 140 | [(_ ov:opt-vars (~var p (term-pattern #'sig #'vars))) 141 | #'(let ([vars (local-vars (hash) ov.expr)]) 142 | p.value)]))]) 143 | body ...))])) 144 | 145 | (module+ test 146 | (check-equal? (term a-signature 2) 147 | (with-signature a-signature (T 2))) 148 | (check-equal? (term a-signature an-A) 149 | (with-signature a-signature (T an-A))) 150 | (with-signature a-signature 151 | (check-equal? (T 2) 2) 152 | (check-equal? (T (foo (foo a-B) a-B)) 153 | (term a-signature (foo (foo a-B) a-B))) 154 | (check-equal? (T (foo Bvar)) 155 | (pattern a-signature (hash) (foo Bvar))))) 156 | -------------------------------------------------------------------------------- /leibniz/test-examples.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide sorts a-signature) 4 | 5 | (require "./sorts.rkt" 6 | "./operators.rkt" 7 | "./builtins.rkt" 8 | "./terms.rkt" 9 | threading) 10 | 11 | (define sorts 12 | (~> (merge-sort-graphs rational-sorts truth-sorts) 13 | (add-sort 'A) (add-sort 'B) 14 | (add-subsort-relation 'B 'A) 15 | (add-sort 'X) (add-sort 'Y) 16 | (add-subsort-relation 'Y 'X))) 17 | 18 | (define a-signature 19 | (~> (foldl (λ (s1 s2) (merge-signatures s1 s2 #f)) 20 | (empty-signature sorts) 21 | (list rational-signature truth-signature)) 22 | (add-op 'an-A empty 'A) 23 | (add-op 'a-B empty 'B) 24 | (add-op 'an-X empty 'X) 25 | (add-op 'a-Y empty 'Y) 26 | (add-op 'foo empty 'B) 27 | (add-op 'foo (list 'B) 'A) 28 | (add-op 'foo (list 'A 'B) 'A) 29 | (add-var 'Avar 'A) 30 | (add-var 'Bvar 'B) 31 | (add-var 'IntVar 'ℤ) 32 | (add-var 'BoolVar 'boolean))) 33 | 34 | -------------------------------------------------------------------------------- /leibniz/tools.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide sort-graph->graphviz 4 | op->graphviz 5 | signature->graphviz) 6 | 7 | (require "./sorts.rkt" 8 | "./operators.rkt" 9 | racket/function 10 | threading) 11 | 12 | (define node-character-translation 13 | (hash "-" "DASH")) 14 | 15 | (define (symbol->node symbol) 16 | (for/fold ([s (symbol->string symbol)]) 17 | ([(from to) node-character-translation]) 18 | (string-replace s from to))) 19 | 20 | (define (sort-graph->graphviz s-graph [sort-or-kind #f]) 21 | (define sorts 22 | (cond 23 | [(sort-graph? s-graph) s-graph] 24 | [(signature? s-graph) (signature-sort-graph s-graph)] 25 | [else (error "illegal input data")])) 26 | (define subset (if sort-or-kind 27 | (kind sorts sort-or-kind) 28 | (all-sorts sorts))) 29 | (printf "digraph sort_graph {\n") 30 | (for ([sort subset]) 31 | (printf "~a [label=\"~a\"];\n" 32 | (symbol->node sort) (symbol->string sort))) 33 | (printf "rankdir=BT;\n") 34 | (for ([ss (all-subsort-relations sorts)] 35 | #:when (set-member? subset (car ss))) 36 | (printf "~a->~a;\n" 37 | (symbol->node (car ss)) 38 | (symbol->node (cdr ss)))) 39 | (when sort-or-kind 40 | (printf "label=\"Sort graph of ~a\";\n" 41 | (constraint->string sorts subset)) 42 | (printf "labelloc=top;\n") 43 | (printf "labeljust=left;\n")) 44 | (printf "}\n")) 45 | 46 | (define (op->graphviz sig op-symbol arg-sorts) 47 | 48 | (define signature 49 | (cond 50 | [(signature? sig) sig] 51 | [else (error "illegal input data")])) 52 | (define sorts (signature-sort-graph signature)) 53 | (define ranks (for/list ([rank (lookup-op-rank-list signature op-symbol arg-sorts)]) 54 | ; translate to the old return value of lookup-op-rank-list 55 | (cons (first rank) (second rank))) ) 56 | 57 | (define (node-label rank) 58 | (apply string-append (map symbol->node (cons (cdr rank) (car rank))))) 59 | 60 | (define (rank->string rank) 61 | (format "~a\n-> ~a" (car rank) (cdr rank))) 62 | 63 | (define (is-subarity? arity1 arity2) 64 | (for/and ([s1 arity1] [s2 arity2]) 65 | (conforms-to? sorts s1 s2))) 66 | 67 | (define (subarity-graph ranks) 68 | (for*/fold ([graph (hash)]) 69 | ([rank1 ranks] 70 | [rank2 ranks] 71 | #:when (and (not (equal? rank1 rank2)) 72 | (is-subarity? (car rank1) (car rank2)))) 73 | (hash-update graph (node-label rank1) 74 | (λ (ns) (set-add ns (node-label rank2))) 75 | (set (node-label rank2))))) 76 | 77 | (define (indirect sa-graph) 78 | (for*/fold ([graph (hash)]) 79 | ([(from tos) sa-graph] 80 | [to tos]) 81 | (define second (hash-ref sa-graph to (set))) 82 | (hash-update graph from 83 | (λ (ns) (set-union ns second)) 84 | second))) 85 | 86 | ; Simplify a subarity graph by removing all edges that 87 | ; are equivalent to existing indirect paths. 88 | (define (simplified sa-graph) 89 | (define i (indirect sa-graph)) 90 | (for/hash ([(from tos) sa-graph]) 91 | (values from (set-subtract tos (hash-ref i from))))) 92 | 93 | (printf "digraph op_ranks {\n") 94 | (printf "rankdir=BT;\n") 95 | (printf "node [shape=box];\n") 96 | (for ([rank ranks]) 97 | (printf "~a [label=\"~a\"];\n" 98 | (node-label rank) 99 | (rank->string rank))) 100 | 101 | (for* ([(node1 node2-list) (simplified (subarity-graph ranks))] 102 | [node2 node2-list]) 103 | (printf "~a -> ~a\n" node1 node2)) 104 | 105 | (printf "label=\"Operator ~a for arity ~s\";\n" 106 | op-symbol 107 | arg-sorts) 108 | (printf "labelloc=top;\n") 109 | (printf "labeljust=left;\n") 110 | (printf "}\n")) 111 | 112 | (define filename-character-translation 113 | (hash "/" "SLASH" 114 | "*" "STAR" 115 | "=" "EQUAL" 116 | ">" "GREATER" 117 | "<" "LESS" 118 | "^" "HAT")) 119 | 120 | (define (symbol->path-element symbol) 121 | (for/fold ([s (symbol->string symbol)]) 122 | ([(from to) filename-character-translation]) 123 | (string-replace s from to))) 124 | 125 | (define (signature->graphviz directory-path sig) 126 | (define signature 127 | (cond 128 | [(signature? sig) sig] 129 | [else (error "illegal input data")])) 130 | (define sorts (signature-sort-graph signature)) 131 | (define base-path (expand-user-path directory-path)) 132 | (make-directory* base-path) 133 | (with-output-to-file (build-path base-path "sorts.dot") 134 | (thunk (sort-graph->graphviz sorts)) 135 | #:mode 'text #:exists 'truncate) 136 | (for ([(symbol k-arity) (ops-by-kind-arity signature)]) 137 | (define arg-sorts (for/list ([kind k-arity]) 138 | (set-first (maximal-sorts sorts kind)))) 139 | (define fname 140 | (string-append 141 | (string-join (map symbol->path-element 142 | (cons 'op 143 | (cons symbol arg-sorts))) 144 | "-") 145 | ".dot")) 146 | (with-output-to-file (build-path base-path fname) 147 | (thunk (op->graphviz signature symbol arg-sorts)) 148 | #:mode 'text #:exists 'truncate))) 149 | -------------------------------------------------------------------------------- /leibniz/transformations.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide transform-context-declarations 4 | hide-context-vars) 5 | 6 | (require (prefix-in sorts: "./sorts.rkt") 7 | (prefix-in operators: "./operators.rkt") 8 | (prefix-in terms: "./terms.rkt") 9 | racket/hash 10 | threading) 11 | 12 | ;; Test cases are in documents.rkt, to avoid cyclic dependencies. 13 | 14 | ;; Hide context-level variables by pushing them into rule and equation definitions. 15 | 16 | (define (hide-context-vars context) 17 | (define transformer (add-context-vars (hash-ref context 'vars))) 18 | (~> context 19 | (hash-update 'rules (λ (rules) (for/list ([r rules]) 20 | (transformer r)))) 21 | (hash-update 'assets (λ (assets) (for/hash ([(label value) assets]) 22 | (values label (transformer value))))) 23 | (hash-set 'vars (hash)))) 24 | 25 | (define ((add-context-vars var-decls) item-decl) 26 | (define (combined-vars local-vars) 27 | ;; The context var is added only if no local var of the same name 28 | ;; already exists. 29 | (hash-union local-vars var-decls #:combine (λ (a b) a))) 30 | (define (transform item) 31 | (match item 32 | [(list (and type-tag (or 'equation 'rule 'transformation)) 33 | vars term1 term2 condition) 34 | (list type-tag (combined-vars vars) term1 term2 condition)] 35 | [(list 'assets assets) 36 | (list 'assets 37 | (for/hash ([(label value) assets]) 38 | (values label (transform value))))] 39 | [(or (list 'as-equation _) 40 | (list 'as-rule _ _) 41 | (list 'substitute _ _) 42 | (list 'transform _ _)) 43 | item] 44 | [(list 'term-or-var name) 45 | (when (hash-has-key? var-decls name) 46 | (error (format "variable ~a has been removed" name))) 47 | item] 48 | [(list 'term op args) 49 | (list 'term op (map transform args))] 50 | [other-term 51 | other-term])) 52 | (transform item-decl)) 53 | 54 | ;; Apply transformations to a context 55 | 56 | (define (transform-context-declarations context transformations) 57 | 58 | (define (transform-included-contexts crefs) 59 | (for/list ([cref crefs]) 60 | (match-define (cons mode name-or-context) cref) 61 | (if (string? name-or-context) 62 | cref 63 | (cons mode (transform-context-declarations name-or-context transformations))))) 64 | 65 | (define (transform-declarations context) 66 | (for/fold ([c context]) 67 | ([tr transformations]) 68 | ((apply-transformation tr) c))) 69 | 70 | (~> context 71 | (hash-update 'includes transform-included-contexts) 72 | transform-declarations)) 73 | 74 | (define ((apply-transformation tr) decls) 75 | (match tr 76 | ['hide-vars 77 | (define transformer (add-context-vars (hash-ref decls 'vars))) 78 | (~> decls 79 | (hash-update 'rules (λ (rules) (for/list ([r rules]) 80 | (transformer r)))) 81 | (hash-update 'assets (λ (assets) (for/hash ([(label value) assets]) 82 | (values label (transformer value))))) 83 | (hash-set 'vars (hash)))] 84 | [(list 'rename-sort sort1 sort2) 85 | (replace-sorts decls (λ (s) (if (equal? s sort1) sort2 s)))] 86 | [(list 'add-include mode cname) 87 | (add-include decls mode cname)] 88 | [(list 'asset-prefix prefix) 89 | (asset-prefix decls prefix)] 90 | [(list 'real->float fp-sort) 91 | (real->float decls fp-sort)])) 92 | 93 | ;; Replace sorts by applying sort-transformer to every sort in a context 94 | 95 | (define (replace-sorts context sort-transformer) 96 | 97 | (define (transform-sorts sorts) 98 | (for/set ([s sorts]) 99 | (sort-transformer s))) 100 | 101 | (define (transform-subsorts subsorts) 102 | (for/set ([ss subsorts]) 103 | (cons (sort-transformer (car ss)) (sort-transformer (cdr ss))))) 104 | 105 | (define (transform-vars vars) 106 | (for/hash ([(name sort) vars]) 107 | (values name (sort-transformer sort)))) 108 | 109 | (define (transform-arg x) 110 | (match x 111 | [(list 'var name sort) 112 | (list 'var name (sort-transformer sort))] 113 | [(list 'sort sort) 114 | (list 'sort (sort-transformer sort))])) 115 | 116 | (define (transform-ops ops) 117 | (for/set ([op ops]) 118 | (match-define (list name arity rsort) op) 119 | (list name 120 | (map transform-arg arity) 121 | (sort-transformer rsort)))) 122 | 123 | (define (transform-item item) 124 | (match item 125 | [(list (and type-tag (or 'equation 'rule 'transformation)) 126 | vars term1 term2 condition) 127 | (list type-tag (transform-vars vars) term1 term2 condition)] 128 | [(list 'assets assets) 129 | (list 'assets 130 | (for/hash ([(label value) assets]) 131 | (values label (transform-item value))))] 132 | [(or (list 'as-equation _) 133 | (list 'as-rule _ _) 134 | (list 'substitute _ _) 135 | (list 'transform _ _)) 136 | item] 137 | [term 138 | term])) 139 | 140 | (define (transform-rules rules) 141 | (map transform-item rules)) 142 | 143 | (define (transform-assets assets) 144 | (second (transform-item (list 'assets assets)))) 145 | 146 | (~> context 147 | (hash-set 'locs (hash)) 148 | (hash-update 'sorts transform-sorts) 149 | (hash-update 'subsorts transform-subsorts) 150 | (hash-update 'vars transform-vars) 151 | (hash-update 'ops transform-ops) 152 | (hash-update 'rules transform-rules) 153 | (hash-update 'assets transform-assets))) 154 | 155 | ;; Add include (use/extend) 156 | 157 | (define (add-include context mode cname-or-context) 158 | (hash-update context 'includes 159 | (λ (crefs) (append crefs (list (cons mode cname-or-context)))))) 160 | 161 | ;; Add a prefix to all asset labels 162 | 163 | (define (asset-prefix context prefix) 164 | 165 | (define (prefixed-label label) 166 | (string->symbol 167 | (string-append 168 | (symbol->string prefix) 169 | "." 170 | (symbol->string label)))) 171 | 172 | (define (transform-item item) 173 | (match item 174 | [(list 'as-equation asset-ref) 175 | (list 'as-equation (prefixed-label asset-ref))] 176 | [(list 'as-rule asset-ref flip?) 177 | (list 'as-rule (prefixed-label asset-ref) flip?)] 178 | [(list (and type-tag (or 'substitute 'transform)) 179 | rule-ref asset-ref reduce?) 180 | (list type-tag (prefixed-label rule-ref) (prefixed-label asset-ref) reduce?)] 181 | [(list 'assets assets) 182 | (list 'assets 183 | (for/hash ([(label value) assets]) 184 | (values label (transform-item value))))] 185 | [other 186 | other])) 187 | 188 | (hash-update context 'assets 189 | (λ (assets) (hash prefix (transform-item (list 'assets assets)))))) 190 | 191 | ;; Convert exact arithmetic on reals to inexact arithmetic on floats 192 | ;; 193 | ;; The principle is to replace all subsorts of ℝ that are not subsorts of ℤ 194 | ;; by FP32 or FP64. Two additional modifications are required: 195 | ;; 196 | ;; 1. Rational constants are converted to float. Integer constants are converted 197 | ;; to float if they take the place of a rational value that just happens to be 198 | ;; an integer. 199 | ;; 2. Rewrite rules that replace a float expression by an integer expression 200 | ;; are converted by adding an int->float conversion on the replacement term. 201 | 202 | (define (real->float context float-sort) 203 | 204 | (define signature (hash-ref context 'compiled-signature)) 205 | (define sort-graph (operators:signature-sort-graph signature)) 206 | (define int-sorts (set-add (sorts:all-subsorts sort-graph 'ℤ) 'ℤ)) 207 | (define non-int-sorts 208 | (set-subtract (set-add (sorts:all-subsorts sort-graph 'ℝ) 'ℝ) int-sorts)) 209 | 210 | (define (transform-sort sort) 211 | (if (set-member? non-int-sorts sort) 212 | float-sort 213 | sort)) 214 | 215 | (define (num->float x) 216 | (case float-sort 217 | [(FP32) (real->single-flonum x)] 218 | [(FP64) (real->double-flonum x)])) 219 | 220 | (define (real-sort? sort) 221 | (sorts:conforms-to? sort-graph sort 'ℝ)) 222 | 223 | (define (int-sort? sort) 224 | (sorts:conforms-to? sort-graph sort 'ℤ)) 225 | 226 | (define (transform-literal term expected-sort) 227 | (if (int-sort? expected-sort) 228 | term 229 | (match term 230 | [(list (or 'integer 'rational 'floating-point) x) 231 | (list 'floating-point (num->float x))] 232 | [_ term]))) 233 | 234 | (define (transform-term term lvars) 235 | (match term 236 | [(list 'term op args) 237 | (define-values (arg-sorts mod-terms) 238 | (for/fold ([arg-sorts empty] 239 | [mod-terms empty]) 240 | ([arg (reverse args)]) 241 | (define-values (as mt) (transform-term arg lvars)) 242 | (values (cons as arg-sorts) (cons mt mod-terms)))) 243 | (define rank (operators:lookup-op signature op arg-sorts)) 244 | (unless rank 245 | (error (format "Illegal term ~a" term))) 246 | (define mod-args 247 | (for/list ([rs (car rank)] 248 | [mt mod-terms]) 249 | (transform-literal mt rs))) 250 | (values (cdr rank) (list 'term op mod-args))] 251 | [(list 'term-or-var name) 252 | (values (terms:term.sort (terms:make-var-or-term signature name lvars)) 253 | term)] 254 | [(list 'integer x) 255 | (values (terms:term.sort x) term)] 256 | [(list (and type (or 'rational 'floating-point)) x) 257 | (values (terms:term.sort x) (list type (num->float x)))] 258 | [#f 259 | (values #f #f)])) 260 | 261 | (define (transform-equation eq) 262 | (match-define (list (and type-tag (or 'equation 'rule 'transformation)) 263 | vars left right condition) eq) 264 | (define-values (lsort mod-left) (transform-term left vars)) 265 | (define-values (rsort mod-right) (transform-term right vars)) 266 | (define-values (csort mod-condition) (transform-term condition vars)) 267 | (if (or (real-sort? lsort) (real-sort? rsort)) 268 | (list type-tag vars 269 | (transform-literal mod-left rsort) 270 | (transform-literal mod-right lsort) 271 | mod-condition) 272 | (list type-tag vars mod-left mod-right mod-condition))) 273 | 274 | (define (transform-item item) 275 | (match item 276 | [(list (or 'equation 'rule 'transformation) args ...) 277 | (transform-equation item)] 278 | [(list 'assets assets) 279 | (list 'assets (for/hash ([(label value) assets]) 280 | (values label (transform-item value))))] 281 | [(or (list 'as-equation _) 282 | (list 'as-rule _ _) 283 | (list 'substitute _ _) 284 | (list 'transform _ _)) 285 | item] 286 | [term 287 | (define-values (t-sort t-term) (transform-term term (hash))) 288 | t-term])) 289 | 290 | (~> context 291 | (hash-update 'rules (λ (rules) (map transform-equation rules))) 292 | (hash-update 'assets (λ (assets) (second (transform-item (list 'assets assets))))) 293 | (replace-sorts transform-sort) 294 | (add-include 'use "builtins/IEEE-floating-point"))) 295 | -------------------------------------------------------------------------------- /logo/horizontal-leibniz-logo-2500-x-1000-jpg.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/logo/horizontal-leibniz-logo-2500-x-1000-jpg.jpg -------------------------------------------------------------------------------- /logo/horizontal-leibniz-logo-2500-x-1000-png.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/logo/horizontal-leibniz-logo-2500-x-1000-png.png -------------------------------------------------------------------------------- /logo/horizontal-leibniz-logo-500-x-150-png.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/logo/horizontal-leibniz-logo-500-x-150-png.png -------------------------------------------------------------------------------- /logo/leibniz-logo-svg.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 10 | 11 | 12 | 13 | 17 | 19 | 23 | 25 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 37 | 39 | 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /logo/vertical-leibniz-logo-2000-x-1600-jpg.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/logo/vertical-leibniz-logo-2000-x-1600-jpg.jpg -------------------------------------------------------------------------------- /logo/vertical-leibniz-logo-2000-x-1600-png.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khinsen/leibniz/d139574e4d3854a2ef23e1d11f6d667beecde241/logo/vertical-leibniz-logo-2000-x-1600-png.png -------------------------------------------------------------------------------- /notes.md: -------------------------------------------------------------------------------- 1 | # Implementation notes 2 | 3 | ## Code structure 4 | 5 | The code consists of several layers that build on each other (top to 6 | bottom): 7 | 8 | - `sorts.rkt` implements the sort-graph, which is a DAG of subsort 9 | relations. 10 | 11 | - `operators.rkt` mplements operators and term algebra signatures, 12 | which define which operators are valid in an algebra and what sort 13 | the resulting terms have as a function of argument sorts. 14 | 15 | - `terms.rkt` and `builtins.rkt` implement standard and built-in 16 | terms. 17 | 18 | - `term-syntax.rkt` is a syntax layer that simplifies writing complex 19 | terms inside Racket code. 20 | 21 | - `equations.rkt` implements equations and rules. 22 | 23 | - `contexts.rkt` implements contexts, which combine a signature for a 24 | term algebra and a list of rules for term simplification. 25 | 26 | - `rewrite.rkt` implements term rewriting. 27 | 28 | - `rewrite-syntax.rkt` implements convenience syntax for doing computations 29 | inside a context. 30 | 31 | - `builtin-contexts.rkt` implements a few built-in contexts 32 | (truth, boolean, numbers). 33 | 34 | - `documents.rkt` implements the interface between the low-level support 35 | code and the Scribble-based language that Leibniz authors use. 36 | 37 | - `lang.rkt` and everything under `lang` implement the Leibniz language, 38 | which is an extension of `scribble/base` that adds commands for 39 | defining sorts, operators, rules etc. 40 | 41 | Three modules are not part of this stack: 42 | 43 | - `condd.rkt` and `lightweight-class.rkt` provide generic utilities 44 | that could well be used in other projects. 45 | 46 | - `test-examples.rkt` contains data structures for testing, used in 47 | various places. 48 | 49 | ## Changes to consider 50 | 51 | ### Term creation 52 | 53 | The API for term creation is far from definitive. Error handling in 54 | particular needs to be defined properly. 55 | 56 | ### Labels in rules and equations 57 | 58 | Labels are not required to be unique, which may turn out to be a bad choice. 59 | 60 | ### The context data structure 61 | 62 | There are two internal data structures for contexts at this time: the low-level 63 | one is defined in `contexts.rkt`, and is used in validation and rewriting. 64 | The higher-level one is defined in `documents.rkt`. It is a parsed version 65 | of what Leibniz authors write, and it is also what the XML representation encodes. 66 | t isn't clear to me yet what the best data structure is for implementing code 67 | transformations, which will be an important part of the Leibniz infrastructure. 68 | These data structures are therefore likely to change over time, and perhaps just 69 | one will survive. 70 | -------------------------------------------------------------------------------- /tools/draw-graphs.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require leibniz 4 | leibniz/tools) 5 | 6 | (define directory (vector-ref (current-command-line-arguments) 0)) 7 | 8 | (signature->graphviz (build-path directory "truth") truth) 9 | (signature->graphviz (build-path directory "boolean") boolean) 10 | (signature->graphviz (build-path directory "integers") integers) 11 | (signature->graphviz (build-path directory "rational-numbers") rational-numbers) 12 | (signature->graphviz (build-path directory "real-numbers") real-numbers) 13 | (signature->graphviz (build-path directory "IEEE-floating-point") IEEE-floating-point) 14 | -------------------------------------------------------------------------------- /tools/draw-graphs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | racket draw-graphs.rkt ../graphs 3 | find ../graphs -name \*.dot -exec dot -Tpdf -O {} \; 4 | -------------------------------------------------------------------------------- /tools/standalone-manual.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | scribble +m --redirect-main http://download.racket-lang.org/releases/6.8/doc/ leibniz.scrbl 3 | --------------------------------------------------------------------------------