Merge pull request #1 from cpressey/modernize
Modernize build, add JS build and HTML5 demo.
Chris Pressey authored 4 years ago
GitHub committed 4 years ago
0 | b967f788cf1245de199bd141548d588f12eeddd2 rel_1_0_2012_0312 | |
1 | 767eb60fc14098cbf448f7b57895e094d49e0e9d rel_1_0_2014_0818 | |
2 | 4891bb82bd2e4adc51482282d05a89b25536bd9a rel_1_0_2015_0101 |
0 | Mascarpone is distributed under the following, BSD-compatible licenses. | |
1 | ||
2 | All documentation is covered by this license, modelled after the | |
3 | "Report on the Programming Language Haskell 98" license: | |
4 | ||
5 | ----------------------------------------------------------------------------- | |
6 | ||
7 | Copyright (c)2007-2014 Chris Pressey, Cat's Eye Technologies. | |
8 | All rights reserved. | |
9 | ||
10 | The authors intend this Report to belong to the entire Mascarpone | |
11 | community, and so we grant permission to copy and distribute it for | |
12 | any purpose, provided that it is reproduced in its entirety, | |
13 | including this Notice. Modified versions of this Report may also be | |
14 | copied and distributed for any purpose, provided that the modified | |
15 | version is clearly presented as such, and that it does not claim to | |
16 | be a definition of the Mascarpone Programming Language. | |
17 | ||
18 | ----------------------------------------------------------------------------- | |
19 | ||
20 | All source code for the reference implementation is covered by this license: | |
21 | ||
22 | ----------------------------------------------------------------------------- | |
23 | ||
24 | Copyright (c)2007-2014 Chris Pressey, Cat's Eye Technologies. | |
25 | All rights reserved. | |
26 | ||
27 | Redistribution and use in source and binary forms, with or without | |
28 | modification, are permitted provided that the following conditions | |
29 | are met: | |
30 | ||
31 | 1. Redistributions of source code must retain the above copyright | |
32 | notices, this list of conditions and the following disclaimer. | |
33 | 2. Redistributions in binary form must reproduce the above copyright | |
34 | notices, this list of conditions, and the following disclaimer in | |
35 | the documentation and/or other materials provided with the | |
36 | distribution. | |
37 | 3. Neither the names of the copyright holders nor the names of their | |
38 | contributors may be used to endorse or promote products derived | |
39 | from this software without specific prior written permission. | |
40 | ||
41 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |
42 | ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT | |
43 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS | |
44 | FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE | |
45 | COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, | |
46 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, | |
47 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; | |
48 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | |
49 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | |
50 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN | |
51 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE | |
52 | POSSIBILITY OF SUCH DAMAGE. |
0 | The Mascarpone Programming Language | |
1 | =================================== | |
2 | ||
3 | Language version 1.0. Distribution version 2012.0312. | |
4 | Chris Pressey, Cat's Eye Technologies | |
5 | ||
6 | *You are lost in a twisty maze of meta-circular interpreters, all | |
7 | alike.* | |
8 | ||
9 | Introduction | |
10 | ------------ | |
11 | ||
12 | Mascarpone is a self-modifying programming language in the style of | |
13 | [Emmental](http://catseye.tc/projects/emmental/). In fact it is a | |
14 | rationalization and further exploration of some of the basic ideas | |
15 | behind Emmental. In Mascarpone, meta-circular interpreters are | |
16 | "first-class objects": they can be pushed onto the stack, have | |
17 | operations extracted from and installed into them, and can themselves be | |
18 | meta-circularly extracted from the language environment ("reified") or | |
19 | installed into it ("deified.") New operations can be defined as strings | |
20 | of symbols, and these symbols are given meaning by an interpreter that | |
21 | is "captured" in the definition, similar to the way that lexical | |
22 | variables are captured in closures in functional languages. An operation | |
23 | may also access, and modify, the interpreter that invoked it. | |
24 | ||
25 | Like Emmental, Mascarpone relies on meta-circular | |
26 | interpreter-modification to achieve Turing-completeness. Unlike | |
27 | Emmental, Mascarpone is purely symbolic; there are no arithmetic | |
28 | instructions. | |
29 | ||
30 | Stack | |
31 | ----- | |
32 | ||
33 | Like Emmental, Mascarpone is a stack-based language. Unlike Emmental, | |
34 | Mascarpone's stack may contain things other than symbols. A stack | |
35 | element in Mascarpone may be a symbol, an operation, or an interpreter. | |
36 | ||
37 | Strings are popped off Mascarpone's stack slightly differently than | |
38 | Emmental's. A string begins with the symbol `]` on the stack; this is | |
39 | popped and discarded. Symbols are then successively popped and prepended | |
40 | to a growing string. As further `]`'s are encountered, they too are | |
41 | prepended to the string, but the nesting level is incremented for each | |
42 | one as well. Whenever a `[` is encountered, it is prepended to the | |
43 | string and the nesting level is decremented, unless it is zero, in which | |
44 | case the `[` is discarded and the string is complete. The net effect of | |
45 | all this futzing around is that `[]` work as nestable quoting symbols. | |
46 | ||
47 | Also unlike Emmental, Mascarpone does not have a queue. | |
48 | ||
49 | Meta-circular Interpreters | |
50 | -------------------------- | |
51 | ||
52 | The idea of an interpreter in Mascarpone is similar to that in Emmental. | |
53 | In Mascarpone, an interpreter is a map that takes symbols to operations, | |
54 | and an operation is a sequence of symbols that is given meaning by some | |
55 | interpreter. | |
56 | ||
57 | Of course, this is a circular definition, but that doesn't seem | |
58 | unreasonable, since we're working with meta-circular interpreters. If | |
59 | you like, you can think of it as forming an "infinite tower of | |
60 | meta-circular interpreters," but that's never been a really satisfying | |
61 | explanation for me. As I explained in the Emmental documentation, I | |
62 | think you need some source of understanding external to the definition | |
63 | in order to make complete sense of a meta-circular interpreter. (I also | |
64 | happen to think that humans have some sort of innate understanding of | |
65 | interpretation — that is, language — so that this demand for further | |
66 | understanding doesn't recurse forever.) | |
67 | ||
68 | There is a special interpreter in Mascarpone called "null". It is an | |
69 | error to try to interpret anything with this interpreter. Expect that | |
70 | any program that tries to do this will come crashing to a halt, or will | |
71 | spin off into space and never be heard from again, or something equally | |
72 | impressive. | |
73 | ||
74 | Every interpreter (except for null) is linked to a "parent" interpreter | |
75 | (which may be null.) No interpreter can be its own ancestor; the | |
76 | parent-child relationships between interpreters form a directed, acyclic | |
77 | graph (or DAG.) | |
78 | ||
79 | There is, at any given time in a Mascarpone, a current interpreter: this | |
80 | is the interpreter that is in force, that is being used to interpret | |
81 | symbols. The parent interpreter of the current interpreter is generally | |
82 | the interpreter that was used to execute the current operation (that is, | |
83 | the operation currently being interpreted; it consists of a string of | |
84 | symbols is interpreted by the current interpreter.) | |
85 | ||
86 | The current interpreter when any top-level Mascarpone program begins is | |
87 | the initial Mascarpone interpreter, which is described in English in the | |
88 | next section. | |
89 | ||
90 | Initial Mascarpone Interpreter | |
91 | ------------------------------ | |
92 | ||
93 | `v` ("reify") pushes the current interpreter onto the stack. | |
94 | ||
95 | `^` ("deify") pops an interpreter from the stack and installs it as the | |
96 | current interpreter. | |
97 | ||
98 | `>` ("extract") pops a symbol from the stack, then pops an interpreter. | |
99 | It pushes onto the stack the operation associated with that symbol in | |
100 | that interpreter. | |
101 | ||
102 | `<` ("install") pops a symbol from the stack, then an operation, then an | |
103 | interpreter. It pushes onto the stack a new interpreter which is the | |
104 | same as the given interpreter, except that in it, the given symbol is | |
105 | associated with the given operation. | |
106 | ||
107 | `{` ("get parent") pops an interpreter from the stack and pushes it's | |
108 | parent interpreter onto the stack. | |
109 | ||
110 | `}` ("set parent") pops an interpreter i from the stack, then pops an | |
111 | interpreter j. It pushes a new interpreter which is the same as i, | |
112 | except that it's parent interpreter is j. | |
113 | ||
114 | `*` ("create") pops an interpreter from the stack, then a string. It | |
115 | creates a new operation defined by how that interpreter would interpret | |
116 | that string of symbols, and pushes that operation onto the stack. | |
117 | ||
118 | `@` ("expand") pops an operation from the stack and pushes a program | |
119 | string, then pushes an interpreter, such that the semantics of running | |
120 | the program string with the interpreter is identical to the semantics of | |
121 | executing the operation. (Note that the program need not be the one that | |
122 | the operation was defined with, only *equivalent* to it, under the given | |
123 | interpreter; this allows one to sensibly expand "intrinsic" operations | |
124 | like those in the initial Mascarpone interpreter.) | |
125 | ||
126 | `!` ("perform") pops an operation from the stack and executes it. | |
127 | ||
128 | `0` ("null") pushes the null interpreter onto the stack. | |
129 | ||
130 | `1` ("uniform") pops an operation from the stack and pushes back an | |
131 | interpreter where all symbols are associated with that operation. | |
132 | ||
133 | `[` ("deepquote") pushes a `[` symbol onto the stack and enters "nested | |
134 | quote mode", which is really another interpreter. In nested quote mode, | |
135 | each symbol is interpreted as an operation which pushes that symbol onto | |
136 | the stack. In addition, the symbols `[` and `]` have special additional | |
137 | meaning: they nest. When a `]` matching the first `[` is encountered, | |
138 | nested quote mode ends, returning to the interpreter previously in | |
139 | effect. | |
140 | ||
141 | `'` ("quotesym") switches to "single-symbol quote mode", which is really | |
142 | yet another interpreter. In single-symbol quote mode, each symbol is | |
143 | interpreted as an operation which pushes that symbol onto the stack, | |
144 | then immediately ends single-symbol quote mode, returning to the | |
145 | interpreter previously in effect. | |
146 | ||
147 | `.` pops a symbol off the stack and sends it to the standard output. | |
148 | ||
149 | `,` waits for a symbol to arrive on standard input, and pushes it onto | |
150 | the stack. | |
151 | ||
152 | `:` duplicates the top element of the stack. | |
153 | ||
154 | `$` pops the top element of the stack and discards it. | |
155 | ||
156 | `/` swaps to the top two elements of the stack. | |
157 | ||
158 | Discussion | |
159 | ---------- | |
160 | ||
161 | ### Design decisions | |
162 | ||
163 | As you can see, Mascarpone's semantics and initial operations are a lot | |
164 | less "fugly" than Emmental's. It's a more expressive language, in that | |
165 | it's easier to elegantly convey things involving interpreters and | |
166 | meta-circularity in Mascarpone than it is in Emmental. It explores at | |
167 | least one idea that I explicitly mentioned in the Emmental documentation | |
168 | that I'd like to explore, namely, having multiple meta-circular | |
169 | interpreters and being able to switch between them (and lo and behold, | |
170 | Mascarpone has very well-developed `[]` and `'` operations.) It's also | |
171 | "prettier" in that there's more attention paid to providing duals of | |
172 | operations (both `*` and `@`, for example.) | |
173 | ||
174 | Mascarpone also appears to be Turing-complete, despite the lack of | |
175 | explicit conditional, repetition, and arithmetic operators. A cyclic | |
176 | meaning can be expressed by an operation which examines its own | |
177 | definition from the parent interpreter of the current interpreter and | |
178 | re-uses it. A conditional can be formed by creating a new interpreter in | |
179 | which one symbol, say `S`, maps to an operation which does something, | |
180 | and in which all other symbols do something else; executing a symbol in | |
181 | this interpreter is tantamount to testing if that symbol is `S`. | |
182 | ||
183 | "But", you point out, "Mascarpone only has one stack! You need at least | |
184 | two stacks in order to simulate a Turing machine's tape." Actually, | |
185 | Mascarpone *does* have another, less obvious stack: each interpreter has | |
186 | a parent interpreter. By getting the current interpreter, modifying it, | |
187 | setting it's parent to be the current interpreter, and setting it as the | |
188 | current interpreter (in Mascarpone: `v`...`v}^`), we "push" something | |
189 | onto it; by getting the current interpreter, getting its parent, and | |
190 | setting that as the current interpreter (`v{^`), we "pop". | |
191 | ||
192 | Actually, even if there was no explicit parent-child relationship | |
193 | between interpreters, we'd still be able to store a stack of | |
194 | interpreters, because each operation in an interpreter has its own | |
195 | interpreter that gives meaning to the symbols in that operation, and | |
196 | *that* interpreter can contain operations that can contain interpreters, | |
197 | etc., etc., ad infinitum. This isn't a very classy way to do it, but | |
198 | it's very reminiscent of how structures can be built in the lambda | |
199 | calculus by trapping abstractions in other abstractions. | |
200 | ||
201 | It's also worth noting that this is how you'd have to accomplish | |
202 | arithmetic, with something like Church numerals done with interpreters | |
203 | and operations, since Mascarpone has nothing but symbols. On the plus | |
204 | side, this means Mascarpone, unlike Emmental, is highly independent of | |
205 | character set or encoding — it doesn't even have to be ordered. Any set | |
206 | of symbols that contains the symbols of the initial Mascarpone | |
207 | interpreter, plus the symbols appearing in the Mascarpone program being | |
208 | executed, plus the symbols that are desired for input and output, ought | |
209 | to suffice. | |
210 | ||
211 | Actually, that's not quite true: it should be a *finite* set. This is | |
212 | mainly for the sake of the definition of the `'` operator: it switches | |
213 | to an interpreter where all symbols indicate operations that push that | |
214 | symbol on the stack. From this we can infer that there should either be | |
215 | a finite number of such operations (and thus symbols,) or somehow these | |
216 | operations know what symbol they are to push. They take the symbol that | |
217 | invoked them as an argument, perhaps. But other operations in Mascarpone | |
218 | do not have such capabilities: an operation need not even be invoked by | |
219 | a symbol, as it could be invoked by the `!` operation, for instance. | |
220 | That would make the operations in the `'` interpreter gratuitously | |
221 | special. And, practically, most character sets, on which sets of symbols | |
222 | are based, are finite, so I don't suppose this restriction is much of a | |
223 | problem. | |
224 | ||
225 | One further, somewhat related design decision deserves mention. Any | |
226 | symbol which is not defined in the initial interpreter is interpreted as | |
227 | a no-op. It probably would have been nicer to treat it as an explicit | |
228 | error-causing operation. This could be extended to looking, inside each | |
229 | putative definition, for symbols undefined in the desired interpreter | |
230 | when executing a `*` operation, and causing a (preferably intelligible) | |
231 | error early in that case. Semantics like this would have helped me save | |
232 | time in debugging one or two of the test case programs. However, while | |
233 | Mascarpone is arguably supposed to be less hostile than Emmental when it | |
234 | comes to being programmed in, it's certainly still not what you'd call a | |
235 | mainstream programming language, so while I'm somewhat irked by this | |
236 | deficiency, I hardly consider it a show-stopper. | |
237 | ||
238 | ### Related Work | |
239 | ||
240 | There are definitely two related works that are worth mentioning: Brian | |
241 | Cantwell Smith's Ph.D. thesis "Procedural Reflection in Programming | |
242 | Languages" (MIT, 1982,) and Friedman and Wand's paper "Reification: | |
243 | Reflection without Metaphysics" (ACM LISP conference, 1984.) (Forgive me | |
244 | for not giving proper, perfectly-formatted, Turabianly-correct | |
245 | references to these two works, but frankly, this is the age of the | |
246 | Internet: if you're interested in either of these papers, and you can't | |
247 | find them, there's something wrong with you! If, on the other hand, you | |
248 | don't have *access* to them, perhaps there's something wrong with the | |
249 | institutions whose assumed goal is to increase the amount of human | |
250 | knowledge — but not, it seems, to widen its availability.) | |
251 | ||
252 | It's hard to say how much influence Smith's 3-LISP language and Friedman | |
253 | and Wand's Brown language (introduced in the respective papers) have had | |
254 | on Mascarpone: probably some, since I had read both of them (well, not | |
255 | *all* of Smith's monster! but enough of it to grasp the main ideas, I | |
256 | think) and thought about what they were trying to convey. (What Brown | |
257 | calls "reflection" I've called "deification" to give a sort of | |
258 | phonological dual to "reification". Also, the term "reflection" seems to | |
259 | have taken on a more general meaning in computer science since the | |
260 | '80's, so I wanted to avoid its use here.) But that was a couple of | |
261 | years previous, and the subject of meta-circular interpreters came up | |
262 | this time from a different angle; Mascarpone came primarily from trying | |
263 | to "un-knot" the ideas behind Emmental, which itself came to be, quite | |
264 | indirectly, from thinking about issues raised by John Reynolds' original | |
265 | work on meta-circularity. | |
266 | ||
267 | Certainly a huge difference that sets Mascarpone apart is that 3-LISP | |
268 | and Brown are caught up in the whole LISP/Scheme thing, so they just use | |
269 | S-expressions and functions to represent reified interpreter parts, | |
270 | which include environments and continuations. Mascarpone, on the other | |
271 | hand, reifies whole interpreters at once, as values which are complete | |
272 | interpreters. Because interpreters contain operations which contain | |
273 | interpreters ("ad infinitum", one might think,) this approach seems to | |
274 | highlight the meta-circularity in a way that is particularly striking. | |
275 | In addition, Mascarpone's "applicative" organization (like XY or Joy; | |
276 | that is, like an idealized version of FORTH) lets it avoid some of the | |
277 | referential issues like names and environments, and gives a nice direct | |
278 | one-symbol-one-operation correspondence. | |
279 | ||
280 | Because Mascarpone has interpreters as first-class values, it is never | |
281 | obliged to make the guts of the running interpreter explicit during | |
282 | reification — it just needs to make that interpreter available as a | |
283 | value. The contract of the `@` operation (which, by the way, was a | |
284 | somewhat late add to the language design, fulfilling the desire for a | |
285 | dual to `*`) says you get a program and an interpreter with semantics | |
286 | *equivalent* to the operation you specify, but it doesn't say *how* | |
287 | they're provided. You could successively perform `@` on an intrinsic | |
288 | operation (like, say, `@` itself) and get successively more explicit | |
289 | definitions, written in Mascarpone, of what `@` means. Each one could be | |
290 | thought of as descending (or ascending? does it matter?) a level in that | |
291 | infinite tower dealie. Or, you might only get back a single, random | |
292 | symbol, and an interpreter where all symbols have the semantics of `@`, | |
293 | with no explanation whatsoever. This inbuilt ambiguity is, I think, the | |
294 | appropriate level of abstraction for such an operation (in a | |
295 | meta-circular context, anyway;) saying that you always get back the | |
296 | program you defined the operation with seems overspecified (and unable | |
297 | to handle the case of intrinsics,) and saying that you always get back | |
298 | something opaque, like a function value, seems quite nonplussing in the | |
299 | context of an interpreter that can supposedly examine its own structure. | |
300 | It's not clear to me that either 3-LISP or Brown addresses this point to | |
301 | this degree. | |
302 | ||
303 | And of course, neither 3-LISP nor Brown tries to use reification and | |
304 | deification as a means of achieving Turing-completeness in the absence | |
305 | of conventional conditional and repetition constructs. | |
306 | ||
307 | Implementation | |
308 | -------------- | |
309 | ||
310 | `mascarpone.hs` is a reference interpreter for Mascarpone written in | |
311 | Haskell. Run the function `mascarpone` on a string, or `demo n` to run | |
312 | one of the included test cases. `mascarpone.hs` also has a much nicer | |
313 | debugging facility than `emmental.hs`; you can run `debug` on a string | |
314 | to view the state of the program (the current instruction, the rest of | |
315 | the program, the stack, and the current interpreter) at each step of | |
316 | execution. And you can run `test n` to debug the test cases. Lastly, | |
317 | there is a `main` function that runs `mascarpone` on a string read from | |
318 | a file named by the first argument, so a Haskell compiler can be used to | |
319 | build a stand-alone Mascarpone interpreter from this source code. | |
320 | ||
321 | Even happier interpreter-redefining! | |
322 | Chris Pressey | |
323 | Chicago, IL | |
324 | December 8, 2007 |
0 | The Mascarpone Programming Language | |
1 | =================================== | |
2 | ||
3 | _Try it online_ [@ catseye.tc](https://catseye.tc/installation/Mascarpone) | |
4 | | _Wiki entry_ [@ esolangs.org](https://esolangs.org/wiki/Mascarpone) | |
5 | | _See also:_ [Mascarpone](https://github.com/catseye/Emmental) | |
6 | ||
7 | - - - - | |
8 | ||
9 | *You are lost in a twisty maze of meta-circular interpreters, all | |
10 | alike.* | |
11 | ||
12 | Introduction | |
13 | ------------ | |
14 | ||
15 | Mascarpone is a self-modifying programming language in the style of | |
16 | [Emmental](http://catseye.tc/node/Emmental/). In fact it is a | |
17 | rationalization and further exploration of some of the basic ideas | |
18 | behind Emmental. In Mascarpone, meta-circular interpreters are | |
19 | "first-class objects": they can be pushed onto the stack, have | |
20 | operations extracted from and installed into them, and can themselves be | |
21 | meta-circularly extracted from the language environment ("reified") or | |
22 | installed into it ("deified.") New operations can be defined as strings | |
23 | of symbols, and these symbols are given meaning by an interpreter that | |
24 | is "captured" in the definition, similar to the way that lexical | |
25 | variables are captured in closures in functional languages. An operation | |
26 | may also access, and modify, the interpreter that invoked it. | |
27 | ||
28 | Like Emmental, Mascarpone relies on meta-circular | |
29 | interpreter-modification to achieve Turing-completeness. Unlike | |
30 | Emmental, Mascarpone is purely symbolic; there are no arithmetic | |
31 | instructions. | |
32 | ||
33 | Stack | |
34 | ----- | |
35 | ||
36 | Like Emmental, Mascarpone is a stack-based language. Unlike Emmental, | |
37 | Mascarpone's stack may contain things other than symbols. A stack | |
38 | element in Mascarpone may be a symbol, an operation, or an interpreter. | |
39 | ||
40 | Strings are popped off Mascarpone's stack slightly differently than | |
41 | Emmental's. A string begins with the symbol `]` on the stack; this is | |
42 | popped and discarded. Symbols are then successively popped and prepended | |
43 | to a growing string. As further `]`'s are encountered, they too are | |
44 | prepended to the string, but the nesting level is incremented for each | |
45 | one as well. Whenever a `[` is encountered, it is prepended to the | |
46 | string and the nesting level is decremented, unless it is zero, in which | |
47 | case the `[` is discarded and the string is complete. The net effect of | |
48 | all this futzing around is that `[]` work as nestable quoting symbols. | |
49 | ||
50 | Also unlike Emmental, Mascarpone does not have a queue. | |
51 | ||
52 | Meta-circular Interpreters | |
53 | -------------------------- | |
54 | ||
55 | The idea of an interpreter in Mascarpone is similar to that in Emmental. | |
56 | In Mascarpone, an interpreter is a map that takes symbols to operations, | |
57 | and an operation is a sequence of symbols that is given meaning by some | |
58 | interpreter. | |
59 | ||
60 | Of course, this is a circular definition, but that doesn't seem | |
61 | unreasonable, since we're working with meta-circular interpreters. If | |
62 | you like, you can think of it as forming an "infinite tower of | |
63 | meta-circular interpreters," but that's never been a really satisfying | |
64 | explanation for me. As I explained in the Emmental documentation, I | |
65 | think you need some source of understanding external to the definition | |
66 | in order to make complete sense of a meta-circular interpreter. (I also | |
67 | happen to think that humans have some sort of innate understanding of | |
68 | interpretation — that is, language — so that this demand for further | |
69 | understanding doesn't recurse forever.) | |
70 | ||
71 | There is a special interpreter in Mascarpone called "null". It is an | |
72 | error to try to interpret anything with this interpreter. Expect that | |
73 | any program that tries to do this will come crashing to a halt, or will | |
74 | spin off into space and never be heard from again, or something equally | |
75 | impressive. | |
76 | ||
77 | Every interpreter (except for null) is linked to a "parent" interpreter | |
78 | (which may be null.) No interpreter can be its own ancestor; the | |
79 | parent-child relationships between interpreters form a directed, acyclic | |
80 | graph (or DAG.) | |
81 | ||
82 | There is, at any given time in a Mascarpone, a current interpreter: this | |
83 | is the interpreter that is in force, that is being used to interpret | |
84 | symbols. The parent interpreter of the current interpreter is generally | |
85 | the interpreter that was used to execute the current operation (that is, | |
86 | the operation currently being interpreted; it consists of a string of | |
87 | symbols is interpreted by the current interpreter.) | |
88 | ||
89 | The current interpreter when any top-level Mascarpone program begins is | |
90 | the initial Mascarpone interpreter, which is described in English in the | |
91 | next section. | |
92 | ||
93 | Initial Mascarpone Interpreter | |
94 | ------------------------------ | |
95 | ||
96 | `v` ("reify") pushes the current interpreter onto the stack. | |
97 | ||
98 | `^` ("deify") pops an interpreter from the stack and installs it as the | |
99 | current interpreter. | |
100 | ||
101 | `>` ("extract") pops a symbol from the stack, then pops an interpreter. | |
102 | It pushes onto the stack the operation associated with that symbol in | |
103 | that interpreter. | |
104 | ||
105 | `<` ("install") pops a symbol from the stack, then an operation, then an | |
106 | interpreter. It pushes onto the stack a new interpreter which is the | |
107 | same as the given interpreter, except that in it, the given symbol is | |
108 | associated with the given operation. | |
109 | ||
110 | `{` ("get parent") pops an interpreter from the stack and pushes it's | |
111 | parent interpreter onto the stack. | |
112 | ||
113 | `}` ("set parent") pops an interpreter i from the stack, then pops an | |
114 | interpreter j. It pushes a new interpreter which is the same as i, | |
115 | except that it's parent interpreter is j. | |
116 | ||
117 | `*` ("create") pops an interpreter from the stack, then a string. It | |
118 | creates a new operation defined by how that interpreter would interpret | |
119 | that string of symbols, and pushes that operation onto the stack. | |
120 | ||
121 | `@` ("expand") pops an operation from the stack and pushes a program | |
122 | string, then pushes an interpreter, such that the semantics of running | |
123 | the program string with the interpreter is identical to the semantics of | |
124 | executing the operation. (Note that the program need not be the one that | |
125 | the operation was defined with, only *equivalent* to it, under the given | |
126 | interpreter; this allows one to sensibly expand "intrinsic" operations | |
127 | like those in the initial Mascarpone interpreter.) | |
128 | ||
129 | `!` ("perform") pops an operation from the stack and executes it. | |
130 | ||
131 | `0` ("null") pushes the null interpreter onto the stack. | |
132 | ||
133 | `1` ("uniform") pops an operation from the stack and pushes back an | |
134 | interpreter where all symbols are associated with that operation. | |
135 | ||
136 | `[` ("deepquote") pushes a `[` symbol onto the stack and enters "nested | |
137 | quote mode", which is really another interpreter. In nested quote mode, | |
138 | each symbol is interpreted as an operation which pushes that symbol onto | |
139 | the stack. In addition, the symbols `[` and `]` have special additional | |
140 | meaning: they nest. When a `]` matching the first `[` is encountered, | |
141 | nested quote mode ends, returning to the interpreter previously in | |
142 | effect. | |
143 | ||
144 | `'` ("quotesym") switches to "single-symbol quote mode", which is really | |
145 | yet another interpreter. In single-symbol quote mode, each symbol is | |
146 | interpreted as an operation which pushes that symbol onto the stack, | |
147 | then immediately ends single-symbol quote mode, returning to the | |
148 | interpreter previously in effect. | |
149 | ||
150 | `.` pops a symbol off the stack and sends it to the standard output. | |
151 | ||
152 | `,` waits for a symbol to arrive on standard input, and pushes it onto | |
153 | the stack. | |
154 | ||
155 | `:` duplicates the top element of the stack. | |
156 | ||
157 | `$` pops the top element of the stack and discards it. | |
158 | ||
159 | `/` swaps to the top two elements of the stack. | |
160 | ||
161 | Discussion | |
162 | ---------- | |
163 | ||
164 | ### Design decisions | |
165 | ||
166 | As you can see, Mascarpone's semantics and initial operations are a lot | |
167 | less "fugly" than Emmental's. It's a more expressive language, in that | |
168 | it's easier to elegantly convey things involving interpreters and | |
169 | meta-circularity in Mascarpone than it is in Emmental. It explores at | |
170 | least one idea that I explicitly mentioned in the Emmental documentation | |
171 | that I'd like to explore, namely, having multiple meta-circular | |
172 | interpreters and being able to switch between them (and lo and behold, | |
173 | Mascarpone has very well-developed `[]` and `'` operations.) It's also | |
174 | "prettier" in that there's more attention paid to providing duals of | |
175 | operations (both `*` and `@`, for example.) | |
176 | ||
177 | Mascarpone also appears to be Turing-complete, despite the lack of | |
178 | explicit conditional, repetition, and arithmetic operators. A cyclic | |
179 | meaning can be expressed by an operation which examines its own | |
180 | definition from the parent interpreter of the current interpreter and | |
181 | re-uses it. A conditional can be formed by creating a new interpreter in | |
182 | which one symbol, say `S`, maps to an operation which does something, | |
183 | and in which all other symbols do something else; executing a symbol in | |
184 | this interpreter is tantamount to testing if that symbol is `S`. | |
185 | ||
186 | "But", you point out, "Mascarpone only has one stack! You need at least | |
187 | two stacks in order to simulate a Turing machine's tape." Actually, | |
188 | Mascarpone *does* have another, less obvious stack: each interpreter has | |
189 | a parent interpreter. By getting the current interpreter, modifying it, | |
190 | setting it's parent to be the current interpreter, and setting it as the | |
191 | current interpreter (in Mascarpone: `v`...`v}^`), we "push" something | |
192 | onto it; by getting the current interpreter, getting its parent, and | |
193 | setting that as the current interpreter (`v{^`), we "pop". | |
194 | ||
195 | Actually, even if there was no explicit parent-child relationship | |
196 | between interpreters, we'd still be able to store a stack of | |
197 | interpreters, because each operation in an interpreter has its own | |
198 | interpreter that gives meaning to the symbols in that operation, and | |
199 | *that* interpreter can contain operations that can contain interpreters, | |
200 | etc., etc., ad infinitum. This isn't a very classy way to do it, but | |
201 | it's very reminiscent of how structures can be built in the lambda | |
202 | calculus by trapping abstractions in other abstractions. | |
203 | ||
204 | It's also worth noting that this is how you'd have to accomplish | |
205 | arithmetic, with something like Church numerals done with interpreters | |
206 | and operations, since Mascarpone has nothing but symbols. On the plus | |
207 | side, this means Mascarpone, unlike Emmental, is highly independent of | |
208 | character set or encoding — it doesn't even have to be ordered. Any set | |
209 | of symbols that contains the symbols of the initial Mascarpone | |
210 | interpreter, plus the symbols appearing in the Mascarpone program being | |
211 | executed, plus the symbols that are desired for input and output, ought | |
212 | to suffice. | |
213 | ||
214 | Actually, that's not quite true: it should be a *finite* set. This is | |
215 | mainly for the sake of the definition of the `'` operator: it switches | |
216 | to an interpreter where all symbols indicate operations that push that | |
217 | symbol on the stack. From this we can infer that there should either be | |
218 | a finite number of such operations (and thus symbols,) or somehow these | |
219 | operations know what symbol they are to push. They take the symbol that | |
220 | invoked them as an argument, perhaps. But other operations in Mascarpone | |
221 | do not have such capabilities: an operation need not even be invoked by | |
222 | a symbol, as it could be invoked by the `!` operation, for instance. | |
223 | That would make the operations in the `'` interpreter gratuitously | |
224 | special. And, practically, most character sets, on which sets of symbols | |
225 | are based, are finite, so I don't suppose this restriction is much of a | |
226 | problem. | |
227 | ||
228 | One further, somewhat related design decision deserves mention. Any | |
229 | symbol which is not defined in the initial interpreter is interpreted as | |
230 | a no-op. It probably would have been nicer to treat it as an explicit | |
231 | error-causing operation. This could be extended to looking, inside each | |
232 | putative definition, for symbols undefined in the desired interpreter | |
233 | when executing a `*` operation, and causing a (preferably intelligible) | |
234 | error early in that case. Semantics like this would have helped me save | |
235 | time in debugging one or two of the test case programs. However, while | |
236 | Mascarpone is arguably supposed to be less hostile than Emmental when it | |
237 | comes to being programmed in, it's certainly still not what you'd call a | |
238 | mainstream programming language, so while I'm somewhat irked by this | |
239 | deficiency, I hardly consider it a show-stopper. | |
240 | ||
241 | ### Related Work | |
242 | ||
243 | There are definitely two related works that are worth mentioning: Brian | |
244 | Cantwell Smith's Ph.D. thesis "Procedural Reflection in Programming | |
245 | Languages" (MIT, 1982,) and Friedman and Wand's paper "Reification: | |
246 | Reflection without Metaphysics" (ACM LISP conference, 1984.) (Forgive me | |
247 | for not giving proper, perfectly-formatted, Turabianly-correct | |
248 | references to these two works, but frankly, this is the age of the | |
249 | Internet: if you're interested in either of these papers, and you can't | |
250 | find them, there's something wrong with you! If, on the other hand, you | |
251 | don't have *access* to them, perhaps there's something wrong with the | |
252 | institutions whose assumed goal is to increase the amount of human | |
253 | knowledge — but not, it seems, to widen its availability.) | |
254 | ||
255 | It's hard to say how much influence Smith's 3-LISP language and Friedman | |
256 | and Wand's Brown language (introduced in the respective papers) have had | |
257 | on Mascarpone: probably some, since I had read both of them (well, not | |
258 | *all* of Smith's monster! but enough of it to grasp the main ideas, I | |
259 | think) and thought about what they were trying to convey. (What Brown | |
260 | calls "reflection" I've called "deification" to give a sort of | |
261 | phonological dual to "reification". Also, the term "reflection" seems to | |
262 | have taken on a more general meaning in computer science since the | |
263 | '80's, so I wanted to avoid its use here.) But that was a couple of | |
264 | years previous, and the subject of meta-circular interpreters came up | |
265 | this time from a different angle; Mascarpone came primarily from trying | |
266 | to "un-knot" the ideas behind Emmental, which itself came to be, quite | |
267 | indirectly, from thinking about issues raised by John Reynolds' original | |
268 | work on meta-circularity. | |
269 | ||
270 | Certainly a huge difference that sets Mascarpone apart is that 3-LISP | |
271 | and Brown are caught up in the whole LISP/Scheme thing, so they just use | |
272 | S-expressions and functions to represent reified interpreter parts, | |
273 | which include environments and continuations. Mascarpone, on the other | |
274 | hand, reifies whole interpreters at once, as values which are complete | |
275 | interpreters. Because interpreters contain operations which contain | |
276 | interpreters ("ad infinitum", one might think,) this approach seems to | |
277 | highlight the meta-circularity in a way that is particularly striking. | |
278 | In addition, Mascarpone's "applicative" organization (like XY or Joy; | |
279 | that is, like an idealized version of FORTH) lets it avoid some of the | |
280 | referential issues like names and environments, and gives a nice direct | |
281 | one-symbol-one-operation correspondence. | |
282 | ||
283 | Because Mascarpone has interpreters as first-class values, it is never | |
284 | obliged to make the guts of the running interpreter explicit during | |
285 | reification — it just needs to make that interpreter available as a | |
286 | value. The contract of the `@` operation (which, by the way, was a | |
287 | somewhat late add to the language design, fulfilling the desire for a | |
288 | dual to `*`) says you get a program and an interpreter with semantics | |
289 | *equivalent* to the operation you specify, but it doesn't say *how* | |
290 | they're provided. You could successively perform `@` on an intrinsic | |
291 | operation (like, say, `@` itself) and get successively more explicit | |
292 | definitions, written in Mascarpone, of what `@` means. Each one could be | |
293 | thought of as descending (or ascending? does it matter?) a level in that | |
294 | infinite tower dealie. Or, you might only get back a single, random | |
295 | symbol, and an interpreter where all symbols have the semantics of `@`, | |
296 | with no explanation whatsoever. This inbuilt ambiguity is, I think, the | |
297 | appropriate level of abstraction for such an operation (in a | |
298 | meta-circular context, anyway;) saying that you always get back the | |
299 | program you defined the operation with seems overspecified (and unable | |
300 | to handle the case of intrinsics,) and saying that you always get back | |
301 | something opaque, like a function value, seems quite nonplussing in the | |
302 | context of an interpreter that can supposedly examine its own structure. | |
303 | It's not clear to me that either 3-LISP or Brown addresses this point to | |
304 | this degree. | |
305 | ||
306 | And of course, neither 3-LISP nor Brown tries to use reification and | |
307 | deification as a means of achieving Turing-completeness in the absence | |
308 | of conventional conditional and repetition constructs. | |
309 | ||
310 | Implementation | |
311 | -------------- | |
312 | ||
313 | `mascarpone.hs` is a reference interpreter for Mascarpone written in | |
314 | Haskell. Run the function `mascarpone` on a string, or `demo n` to run | |
315 | one of the included test cases. `mascarpone.hs` also has a much nicer | |
316 | debugging facility than `emmental.hs`; you can run `debug` on a string | |
317 | to view the state of the program (the current instruction, the rest of | |
318 | the program, the stack, and the current interpreter) at each step of | |
319 | execution. And you can run `test n` to debug the test cases. Lastly, | |
320 | there is a `main` function that runs `mascarpone` on a string read from | |
321 | a file named by the first argument, so a Haskell compiler can be used to | |
322 | build a stand-alone Mascarpone interpreter from this source code. | |
323 | ||
324 | Even happier interpreter-redefining! | |
325 | Chris Pressey | |
326 | Chicago, IL | |
327 | December 8, 2007 |
0 | This is free and unencumbered software released into the public domain. | |
1 | ||
2 | Anyone is free to copy, modify, publish, use, compile, sell, or | |
3 | distribute this software, either in source code form or as a compiled | |
4 | binary, for any purpose, commercial or non-commercial, and by any | |
5 | means. | |
6 | ||
7 | In jurisdictions that recognize copyright laws, the author or authors | |
8 | of this software dedicate any and all copyright interest in the | |
9 | software to the public domain. We make this dedication for the benefit | |
10 | of the public at large and to the detriment of our heirs and | |
11 | successors. We intend this dedication to be an overt act of | |
12 | relinquishment in perpetuity of all present and future rights to this | |
13 | software under copyright law. | |
14 | ||
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, | |
16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF | |
17 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. | |
18 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR | |
19 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, | |
20 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR | |
21 | OTHER DEALINGS IN THE SOFTWARE. | |
22 | ||
23 | For more information, please refer to <http://unlicense.org/> |
0 | #!/bin/sh | |
1 | ||
2 | THIS=`realpath $0` | |
3 | DIR=`dirname $THIS` | |
4 | NAME=`basename $THIS` | |
5 | SRC=$DIR/../src | |
6 | if [ "x$FORCE_HUGS" != "x" ] ; then | |
7 | exec runhugs -i$SRC $SRC/Main.hs $* | |
8 | elif [ -x $DIR/$NAME.exe ] ; then | |
9 | exec $DIR/$NAME.exe $* | |
10 | elif command -v runhaskell 2>&1 >/dev/null ; then | |
11 | exec runhaskell -i$SRC $SRC/Main.hs $* | |
12 | elif command -v runhugs 2>&1 >/dev/null ; then | |
13 | exec runhugs -i$SRC $SRC/Main.hs $* | |
14 | else | |
15 | echo "Cannot run $NAME; neither $NAME.exe, nor runhaskell, nor runhugs found." | |
16 | exit 1 | |
17 | fi |
1 | 1 | |
2 | 2 | PROG=mascarpone |
3 | 3 | |
4 | if [ x`which ghc` = x -a x`which runhugs` = x ]; then | |
5 | echo "Neither ghc nor runhugs found on search path." | |
6 | exit 1 | |
4 | if command -v ghc >/dev/null 2>&1; then | |
5 | echo "building $PROG.exe with ghc" | |
6 | (cd src && ghc --make Main.hs -o ../bin/$PROG.exe) | |
7 | else | |
8 | echo "ghc not found, not building $PROG.exe" | |
7 | 9 | fi |
8 | 10 | |
9 | mkdir -p bin | |
11 | # For this to work, you need hastec installed. | |
10 | 12 | |
11 | if [ x`which ghc` = x -o ! x$USE_HUGS = x ]; then | |
12 | # create script to run with Hugs | |
13 | cat >bin/$PROG <<'EOF' | |
14 | #!/bin/sh | |
15 | THIS=`realpath $0` | |
16 | DIR=`dirname $THIS`/../src | |
17 | runhugs $DIR/Main.hs $* | |
18 | EOF | |
19 | chmod 755 bin/$PROG | |
13 | if command -v hastec >/dev/null 2>&1; then | |
14 | echo "building $PROG.js with hastec" | |
15 | (cd src && hastec --make HasteMain.hs -o ../demo/$PROG.js) | |
20 | 16 | else |
21 | cd src && ghc --make Main.hs -o ../bin/$PROG | |
17 | echo "hastec not found, not building $PROG.js" | |
22 | 18 | fi |
0 | #!/bin/sh | |
1 | ||
2 | find . -name "*.o" -exec rm {} \; | |
3 | find . -name "*.hi" -exec rm {} \; | |
4 | find . -name "*.jsmod" -exec rm {} \; | |
5 | find . -name "*.exe" -exec rm {} \; |
0 | function launch(config) { | |
1 | config.container.innerHTML = ` | |
2 | <textarea id="prog" rows="10" cols="80"></textarea> | |
3 | <div id="control-panel"></div> | |
4 | <div>Input: <input id="prog-input"></input></div> | |
5 | <div>Output: <pre id="prog-output"></pre></div> | |
6 | <div><button id="run-button">Run</button></div> | |
7 | <pre id="result"></pre> | |
8 | `; | |
9 | ||
10 | function makeSelect(container, labelText, optionsArray, fun) { | |
11 | var label = document.createElement('label'); | |
12 | label.innerHTML = labelText; | |
13 | container.appendChild(label); | |
14 | var select = document.createElement("select"); | |
15 | for (var i = 0; i < optionsArray.length; i++) { | |
16 | var op = document.createElement("option"); | |
17 | op.text = optionsArray[i].filename; | |
18 | op.value = optionsArray[i].contents; | |
19 | select.options.add(op); | |
20 | } | |
21 | select.onchange = function(e) { | |
22 | fun(optionsArray[select.selectedIndex]); | |
23 | }; | |
24 | select.selectedIndex = 0; | |
25 | label.appendChild(select); | |
26 | return select; | |
27 | }; | |
28 | ||
29 | function selectOptionByText(selectElem, text) { | |
30 | var optElem; | |
31 | for (var i = 0; optElem = selectElem.options[i]; i++) { | |
32 | if (optElem.text === text) { | |
33 | selectElem.selectedIndex = i; | |
34 | selectElem.dispatchEvent(new Event('change')); | |
35 | return; | |
36 | } | |
37 | } | |
38 | } | |
39 | ||
40 | var controlPanel = document.getElementById('control-panel'); | |
41 | var select = makeSelect(controlPanel, "example program:", examplePrograms, function(option) { | |
42 | document.getElementById('prog').value = option.contents; | |
43 | }); | |
44 | selectOptionByText(select, config.initialOption); | |
45 | } |
0 | <!DOCTYPE html> | |
1 | <head> | |
2 | <meta charset="utf-8"> | |
3 | <title>Mascarpone</title> | |
4 | </head> | |
5 | <body> | |
6 | ||
7 | <h1>Mascarpone</h1> | |
8 | ||
9 | <p>(Mascarpone.hs compiled to .js by <code>hastec</code>, running in HTML5 document)</p> | |
10 | ||
11 | <div id="installation"></div> | |
12 | ||
13 | <script src="../eg/examplePrograms.jsonp.js"></script> | |
14 | <script src="hastec-io-launcher.js"></script> | |
15 | <script src="mascarpone.js"></script> | |
16 | <script> | |
17 | launch({ | |
18 | container: document.getElementById('installation'), | |
19 | initialOption: "hello.mascarpone" | |
20 | }); | |
21 | </script> | |
22 | </body> |
0 | v['[/''/']v*]v*'?<^'p?!. |
0 | examplePrograms = [ | |
1 | { | |
2 | "contents": "v['[/''/']v*]v*'?<^'p?!.\n", | |
3 | "filename": "capture.mascarpone" | |
4 | }, | |
5 | { | |
6 | "contents": "[o[ll]eh].........\n", | |
7 | "filename": "hello.mascarpone" | |
8 | }, | |
9 | { | |
10 | "contents": "v['[/''/']v*]v*'?<^v[/?/<]v*'S<[>!]v*'F<^[]v*1'p'kS'kF.\n", | |
11 | "filename": "interpreter-as-store.mascarpone" | |
12 | }, | |
13 | { | |
14 | "contents": "v['[/''/']v*]v*'?<^v,>@$............\n", | |
15 | "filename": "output-definition.mascarpone" | |
16 | } | |
17 | ]; |
0 | [o[ll]eh]......... |
0 | v['[/''/']v*]v*'?<^v[/?/<]v*'S<[>!]v*'F<^[]v*1'p'kS'kF. |
0 | v['[/''/']v*]v*'?<^v,>@$............ |
0 | {-# LANGUAGE OverloadedStrings #-} | |
1 | ||
2 | module Main where | |
3 | ||
4 | import Haste.DOM (withElems, getValue, setProp) | |
5 | import Haste.Events (onEvent, MouseEvent(Click)) | |
6 | import Haste.Foreign (ffi) | |
7 | ||
8 | import Language.Mascarpone (getStack, mascarponeWithIO) | |
9 | ||
10 | ||
11 | getCh :: IO Char | |
12 | getCh = ffi "(function() {var i=document.getElementById('prog-input'); var s=i.value; i.value=s.substring(1); return s.charCodeAt(0);})" | |
13 | ||
14 | putCh :: Char -> IO () | |
15 | putCh = ffi "(function(c) {var o=document.getElementById('prog-output'); o.textContent += String.fromCharCode(c);})" | |
16 | ||
17 | clearOutput :: IO () | |
18 | clearOutput = ffi "(function(c) {var o=document.getElementById('prog-output'); o.textContent = '';})" | |
19 | ||
20 | main = withElems ["prog", "result", "run-button"] driver | |
21 | ||
22 | driver [progElem, resultElem, runButtonElem] = | |
23 | onEvent runButtonElem Click $ \_ -> do | |
24 | Just prog <- getValue progElem | |
25 | clearOutput | |
26 | r <- mascarponeWithIO (getCh) (putCh) prog | |
27 | setProp resultElem "textContent" $ show $ getStack $ r |
0 | -- | |
1 | -- mascarpone.hs v2020.0403 | |
2 | -- | |
3 | -- Reference interpreter for | |
4 | -- The Mascarpone Programming Language | |
5 | -- v1.0 | |
6 | -- | |
7 | -- This work is in the public domain. See the file UNLICENSE in the | |
8 | -- root directory of the Mascarpone distribution for more details. | |
9 | -- | |
10 | ||
11 | module Language.Mascarpone where | |
12 | ||
13 | import qualified Data.Map as Map | |
14 | import qualified Data.Char as Char | |
15 | ||
16 | ----------------------------------------------------------------------- | |
17 | -- ============================ Symbols ============================ -- | |
18 | ----------------------------------------------------------------------- | |
19 | ||
20 | type Symbol = Char | |
21 | ||
22 | ||
23 | ----------------------------------------------------------------------- | |
24 | -- ============================== Data ============================= -- | |
25 | ----------------------------------------------------------------------- | |
26 | ||
27 | data Datum = Symbol Symbol | |
28 | | Operation Operation | |
29 | | Interpreter Interpreter | |
30 | deriving (Show) | |
31 | ||
32 | ||
33 | ----------------------------------------------------------------------- | |
34 | -- ============================= Stacks ============================ -- | |
35 | ----------------------------------------------------------------------- | |
36 | ||
37 | data Stack = Stack [Datum] | |
38 | ||
39 | instance Show Stack where | |
40 | show (Stack datumList) = | |
41 | "[(bottom) " ++ showStack (reverse datumList) ++ "(top)]" | |
42 | ||
43 | showStack [] = "" | |
44 | showStack ((Symbol sym):tail) = "'" ++ [sym] ++ "' " ++ (showStack tail) | |
45 | showStack ((Operation op):tail) = (show op) ++ " " ++ (showStack tail) | |
46 | showStack ((Interpreter i):tail) = (show i) ++ " " ++ (showStack tail) | |
47 | ||
48 | pop (Stack (head:tail)) = (head, Stack tail) | |
49 | push (Stack tail) head = (Stack (head:tail)) | |
50 | ||
51 | pushString stack string = pushString' stack ("[" ++ string ++ "]") | |
52 | pushString' stack [] = stack | |
53 | pushString' stack (head:tail) = | |
54 | let | |
55 | stack' = push stack (Symbol head) | |
56 | in | |
57 | pushString' stack' tail | |
58 | ||
59 | popString (Stack ((Symbol ']'):tail)) = popString' (Stack tail) 0 | |
60 | ||
61 | popString' (Stack ((Symbol ']'):tail)) level = | |
62 | let | |
63 | (string, stack') = popString' (Stack tail) (level + 1) | |
64 | in | |
65 | (string ++ [']'], stack') | |
66 | popString' (Stack ((Symbol '['):tail)) 0 = ([], Stack tail) | |
67 | popString' (Stack ((Symbol '['):tail)) level = | |
68 | let | |
69 | (string, stack') = popString' (Stack tail) (level - 1) | |
70 | in | |
71 | (string ++ ['['], stack') | |
72 | popString' (Stack ((Symbol head):tail)) level = | |
73 | let | |
74 | (string, stack') = popString' (Stack tail) level | |
75 | in | |
76 | (string ++ [head], stack') | |
77 | ||
78 | ||
79 | ----------------------------------------------------------------------- | |
80 | -- ======================== Program States ========================= -- | |
81 | ----------------------------------------------------------------------- | |
82 | ||
83 | data State = State { | |
84 | stack :: Stack, | |
85 | interpreter :: Interpreter, | |
86 | debugger :: Debugger, | |
87 | getCh :: IO Char, | |
88 | putCh :: Char -> IO () | |
89 | } | |
90 | ||
91 | ||
92 | ||
93 | getInterpreter State{ interpreter=i } = i | |
94 | setInterpreter state i = state{ interpreter=i } | |
95 | ||
96 | getStack State{ stack=s } = s | |
97 | ||
98 | statePush st@State{ stack=s } head = st{ stack=(push s head) } | |
99 | statePushString st@State{ stack=s } str = st{ stack=(pushString s str) } | |
100 | ||
101 | statePop st@State{ stack=s } = | |
102 | let | |
103 | (elem, s') = pop s | |
104 | in | |
105 | (elem, st{ stack=s' }) | |
106 | statePopString st@State{ stack=s } = | |
107 | let | |
108 | (string, s') = popString s | |
109 | in | |
110 | (string, st{ stack=s' }) | |
111 | ||
112 | stateDebug program st@State{ debugger=debugger } = | |
113 | debugger program st | |
114 | ||
115 | ||
116 | ----------------------------------------------------------------------- | |
117 | -- ========================= Interpreters ========================== -- | |
118 | ----------------------------------------------------------------------- | |
119 | ||
120 | -- | |
121 | -- An interpreter maps symbols onto operations. The map is given as a | |
122 | -- finite function (a finite set of pairs of symbols and operations,) | |
123 | -- plus an operation which is the "default" which is assumed when there | |
124 | -- is no explicit operation present for a given symbol. Each interpreter | |
125 | -- also has a "parent" interpreter, which may be null (NoInterp.) | |
126 | -- | |
127 | ||
128 | data InterpreterSort = Initial | |
129 | | DeepQuote | |
130 | | SingleQuote | |
131 | | Custom | |
132 | ||
133 | data Interpreter = Interp InterpreterSort (Map.Map Symbol Operation) Operation Interpreter | |
134 | | NoInterp | |
135 | ||
136 | instance Show Interpreter where | |
137 | show (Interp Initial _ _ parent) = | |
138 | "|Initial|->" ++ (show parent) | |
139 | show (Interp DeepQuote _ _ parent) = | |
140 | "|DeepQuote|->" ++ (show parent) | |
141 | show (Interp SingleQuote _ _ parent) = | |
142 | "|SingleQuote|->" ++ (show parent) | |
143 | show (Interp Custom map def parent) = | |
144 | "|" ++ (show map) ++ ", default=" ++ (show def) ++ "|->" ++ (show parent) | |
145 | show NoInterp = | |
146 | "|None|" | |
147 | ||
148 | -- | |
149 | -- Retrieve the operation associated with the given symbol. | |
150 | -- | |
151 | ||
152 | fetch (Interp _ map def _) sym = Map.findWithDefault def sym map | |
153 | ||
154 | -- | |
155 | -- Return a derived interpreter where the given symbol is associated | |
156 | -- with the given operation. | |
157 | -- | |
158 | ||
159 | supplant (Interp _ map def parent) sym op = (Interp Custom (Map.insert sym op map) def parent) | |
160 | ||
161 | -- | |
162 | -- Retrieve the parent interpreter of the given interpreter. | |
163 | -- | |
164 | ||
165 | getParent (Interp _ _ _ parent) = parent | |
166 | ||
167 | -- | |
168 | -- Return a derived interpreter where the parent interpreter is the given | |
169 | -- interpreter. | |
170 | -- | |
171 | ||
172 | setParent (Interp sort map def _) parent = Interp sort map def parent | |
173 | ||
174 | ||
175 | ----------------------------------------------------------------------- | |
176 | -- ========================== Operations =========================== -- | |
177 | ----------------------------------------------------------------------- | |
178 | ||
179 | -- | |
180 | -- An operation is a string of symbols given meaning by an interpreter. | |
181 | -- | |
182 | -- Of course, that definition is more conceptual than practical; | |
183 | -- in this implementation, we also have Intrinsic operations, which are | |
184 | -- part of the inital Mascarpone interpreter, and are defined by | |
185 | -- Haskell functions. | |
186 | -- | |
187 | -- The Symbol in the Intrinsic alternative is only for aesthetic | |
188 | -- purposes: it indicates what symbol is associated with the | |
189 | -- operation in the initial Mascarpone interpreter, so that Show | |
190 | -- Operation, and the result of expandOp, are somewhat more human- | |
191 | -- friendly. However, it is semantically immaterial. | |
192 | -- | |
193 | ||
194 | data Operation = Intrinsic Symbol (State -> IO State) | |
195 | | Program [Symbol] Interpreter | |
196 | ||
197 | instance Show Operation where | |
198 | show (Intrinsic sym _) = "[[intrinsic '" ++ [sym] ++ "']]" | |
199 | show (Program string interpreter) = "[[" ++ show string ++ "/" ++ show interpreter ++ "]]" | |
200 | ||
201 | -- | |
202 | -- Execute the given operation in the given state. | |
203 | -- | |
204 | ||
205 | execute :: Operation -> State -> IO State | |
206 | ||
207 | execute (Intrinsic _ f) state = | |
208 | f state | |
209 | ||
210 | -- | |
211 | -- Note that when we call an operation that was defined using a "captured" | |
212 | -- interpreter, we do the following: | |
213 | -- | |
214 | -- 1. We attach the current interpreter as the parent interpreter of the | |
215 | -- captured interpreter | |
216 | -- 2. We interpret the symbols in the operation definition using the captured | |
217 | -- interpreter | |
218 | -- 3. When we have reached the end, we extract the parent interpreter of the | |
219 | -- captured interpreter and use it as the new current interpreter | |
220 | -- | |
221 | -- Note that this means two things: | |
222 | -- | |
223 | -- 1. The operation definition may modify its current interpreter (the | |
224 | -- captured interpreter) to its heart's content; this will not modify | |
225 | -- our current interpreter (the parent interpreter) | |
226 | -- 2. The operation definition may modify our current interpreter by | |
227 | -- modifying the parent interpreter of its current interpreter. | |
228 | -- | |
229 | ||
230 | execute (Program programText capturedInterpreter) state = | |
231 | let | |
232 | callersInterpreter = getInterpreter state | |
233 | capturedInterpreter' = setParent capturedInterpreter callersInterpreter | |
234 | state' = setInterpreter state capturedInterpreter' | |
235 | in | |
236 | execute' programText state' | |
237 | ||
238 | execute' [] state = | |
239 | let | |
240 | capturedInterpreter = getInterpreter state | |
241 | callersInterpreter = getParent capturedInterpreter | |
242 | state' = setInterpreter state callersInterpreter | |
243 | in | |
244 | do return state' | |
245 | ||
246 | execute' program@(symbol:tail) state = | |
247 | let | |
248 | interpreter = getInterpreter state | |
249 | operation = fetch interpreter symbol | |
250 | in do | |
251 | stateDebug program state | |
252 | state' <- execute operation state | |
253 | execute' tail state' | |
254 | ||
255 | -- | |
256 | -- Expand an operation into a program (string of symbols) and an | |
257 | -- interpreter, such that the string of symbols, when interpreted | |
258 | -- by that interpreter, does the same things as the operation. | |
259 | -- | |
260 | -- This happens to return, for program-defined operations, the same | |
261 | -- program and interpreter that the operation was created using, | |
262 | -- and for intrinsic operations, the program consisting only of | |
263 | -- the symbol used for that intrinsic operation in the inital | |
264 | -- Mascarpone interpreter, plus the initial Mascarpone interpreter. | |
265 | -- However, there are an infinite number of other possible correct | |
266 | -- returns. | |
267 | -- | |
268 | ||
269 | expandOp :: Operation -> ([Symbol], Interpreter) | |
270 | ||
271 | expandOp (Program str interp) = | |
272 | (str, interp) | |
273 | expandOp (Intrinsic sym _) = | |
274 | let | |
275 | prog = [sym] | |
276 | in | |
277 | (prog, initialInterpreter) | |
278 | ||
279 | ||
280 | ------------------------------------------------------------ | |
281 | --------------- The operations themselves. ----------------- | |
282 | ------------------------------------------------------------ | |
283 | ||
284 | ||
285 | -- | |
286 | -- Miscellaneous operations. | |
287 | -- | |
288 | ||
289 | -- | |
290 | -- Do nothing. | |
291 | -- | |
292 | ||
293 | opNop state = | |
294 | do return state | |
295 | ||
296 | -- | |
297 | -- Push the null interpreter onto the stack. | |
298 | -- | |
299 | ||
300 | opPushNullInterpreter state = | |
301 | do return (statePush state (Interpreter NoInterp)) | |
302 | ||
303 | -- | |
304 | -- Pop an operation, create an interpreter where all symbols | |
305 | -- are associated with that operation, and push that interpreter | |
306 | -- onto the stack. | |
307 | -- | |
308 | ||
309 | opMakeUniformInterpreter state = | |
310 | let | |
311 | ((Operation op), state') = statePop state | |
312 | interpreter = Interp Custom Map.empty op NoInterp | |
313 | in | |
314 | do return (statePush state' (Interpreter interpreter)) | |
315 | ||
316 | -- | |
317 | -- Push the current interpreter onto the stack. | |
318 | -- | |
319 | ||
320 | opReify state = | |
321 | let | |
322 | interpreter = getInterpreter state | |
323 | state' = statePush state (Interpreter interpreter) | |
324 | in | |
325 | do return state' | |
326 | ||
327 | -- | |
328 | -- Pop an interpreter from the stack and use it to interpret | |
329 | -- the remainder of the program. | |
330 | -- | |
331 | ||
332 | opDiefy state = | |
333 | let | |
334 | ((Interpreter interpreter), state') = statePop state | |
335 | state'' = setInterpreter state' interpreter | |
336 | in | |
337 | do return state'' | |
338 | ||
339 | -- | |
340 | -- Pop an interpreter from the stack, and push back onto | |
341 | -- the stack the interpreter's parent interpreter. | |
342 | -- | |
343 | ||
344 | opGetParent state = | |
345 | let | |
346 | ((Interpreter interpreter), state') = statePop state | |
347 | state'' = statePush state' (Interpreter (getParent interpreter)) | |
348 | in | |
349 | do return state'' | |
350 | ||
351 | -- | |
352 | -- Pop an interpreter i from the stack, then another interpreter j. | |
353 | -- Push a new interpreter that is the same as i, but has j as its parent. | |
354 | -- | |
355 | -- So the stack looks like this: newParent oldInterp -> newInterp | |
356 | -- | |
357 | ||
358 | opSetParent state = | |
359 | let | |
360 | ((Interpreter interpreter), state') = statePop state | |
361 | ((Interpreter parent), state'') = statePop state' | |
362 | interpreter' = setParent interpreter parent | |
363 | state''' = statePush state'' (Interpreter interpreter') | |
364 | in | |
365 | do return state''' | |
366 | ||
367 | -- | |
368 | -- Pop a symbol and an interpreter and push the operation that | |
369 | -- corresponds with that symbol in that interpreter. | |
370 | -- | |
371 | ||
372 | opExtractOp state = | |
373 | let | |
374 | ((Symbol sym), state') = statePop state | |
375 | ((Interpreter interp), state'') = statePop state' | |
376 | op = fetch interp sym | |
377 | state''' = statePush state'' (Operation op) | |
378 | in | |
379 | do return state''' | |
380 | ||
381 | -- | |
382 | -- Pop a symbol, an operation, and an interpreter, and push a new | |
383 | -- interpreter in which that symbol is associated with that operation. | |
384 | -- | |
385 | ||
386 | opInstallOp state = | |
387 | let | |
388 | ((Symbol sym), state') = statePop state | |
389 | ((Operation op), state'') = statePop state' | |
390 | ((Interpreter interp), state''') = statePop state'' | |
391 | interp' = supplant interp sym op | |
392 | state'''' = statePush state''' (Interpreter interp') | |
393 | in | |
394 | do return state'''' | |
395 | ||
396 | -- | |
397 | -- Pop an operation from the stack and perform it. | |
398 | -- | |
399 | ||
400 | opPerform state = | |
401 | let | |
402 | ((Operation op), state') = statePop state | |
403 | in | |
404 | execute op state' | |
405 | ||
406 | -- | |
407 | -- Pop an interpreter and a program from the stack and | |
408 | -- compose an operation that has the effect of running | |
409 | -- that program on that interpreter. | |
410 | -- | |
411 | ||
412 | opCreateOp state = | |
413 | let | |
414 | ((Interpreter interp), state') = statePop state | |
415 | (string, state'') = statePopString state' | |
416 | op = Program string interp | |
417 | state''' = statePush state'' (Operation op) | |
418 | in | |
419 | do return state''' | |
420 | ||
421 | -- | |
422 | -- Pop an operation from the stack and push a program, | |
423 | -- then an interpreter, onto the stack. The semantics | |
424 | -- of running that program with that interpreter will | |
425 | -- be identical to the semantics of executing the operation. | |
426 | -- However, the operation need not have been defined with | |
427 | -- that program or that interpreter. (This means one can | |
428 | -- sensibly expand intrinsic operations.) | |
429 | -- | |
430 | ||
431 | opExpandOp state = | |
432 | let | |
433 | ((Operation op), state') = statePop state | |
434 | (prog, interp) = expandOp op | |
435 | state'' = statePushString state' prog | |
436 | state''' = statePush state'' (Interpreter interp) | |
437 | in | |
438 | do return state''' | |
439 | ||
440 | ||
441 | -- | |
442 | -- Stack manipulation. | |
443 | -- | |
444 | ||
445 | -- | |
446 | -- Discard the top element of the stack. | |
447 | -- | |
448 | ||
449 | opDiscard state = | |
450 | let | |
451 | (_, state') = statePop state | |
452 | in | |
453 | do return state' | |
454 | ||
455 | -- | |
456 | -- Duplicate the top element of the stack. | |
457 | -- | |
458 | ||
459 | opDuplicate state = | |
460 | let | |
461 | (elem, _) = statePop state | |
462 | state' = statePush state elem | |
463 | in | |
464 | do return state' | |
465 | ||
466 | -- | |
467 | -- Swaps the top two elements of the stack. | |
468 | -- | |
469 | ||
470 | opSwap state = | |
471 | let | |
472 | (elem_top, state') = statePop state | |
473 | (elem_bot, state'') = statePop state' | |
474 | state''' = statePush state'' elem_top | |
475 | state'''' = statePush state''' elem_bot | |
476 | in | |
477 | do return state'''' | |
478 | ||
479 | -- | |
480 | -- I/O. | |
481 | -- | |
482 | ||
483 | opInput state = do | |
484 | symbol <- getCh state | |
485 | return (statePush state (Symbol symbol)) | |
486 | ||
487 | opOutput state = | |
488 | let | |
489 | ((Symbol symbol), state') = statePop state | |
490 | in do | |
491 | putCh state symbol | |
492 | return state' | |
493 | ||
494 | -- | |
495 | -- Parameterizable operations. | |
496 | -- | |
497 | ||
498 | opPushValue value state = | |
499 | do return (statePush state value) | |
500 | ||
501 | opPushSymbol symbol state = | |
502 | opPushValue (Symbol symbol) state | |
503 | ||
504 | opPushAndRetreat symbol state = | |
505 | let | |
506 | state' = statePush state (Symbol symbol) | |
507 | interp = getInterpreter state' | |
508 | interp' = getParent interp | |
509 | state'' = setInterpreter state' interp' | |
510 | in | |
511 | do return state'' | |
512 | ||
513 | -- | |
514 | -- Quote stuff. | |
515 | -- | |
516 | ||
517 | opDescendQuote state = | |
518 | let | |
519 | state' = setInterpreter state deepQuoteInterpreter | |
520 | state'' = statePush state' (Symbol '[') | |
521 | in | |
522 | do return state'' | |
523 | where | |
524 | deepQuoteInterpreter = Interp | |
525 | DeepQuote | |
526 | (Map.fromList | |
527 | ([(sym, (Intrinsic sym (opPushSymbol sym))) | | |
528 | sym <- [(Char.chr 0) .. (Char.chr 255)]] | |
529 | ++ | |
530 | [('[', (Intrinsic '[' opDescendQuote)), | |
531 | (']', (Intrinsic ']' opAscendQuote))]) | |
532 | ) | |
533 | (Intrinsic ' ' opNop) | |
534 | (getInterpreter state) | |
535 | ||
536 | opAscendQuote state = | |
537 | let | |
538 | interp = getInterpreter state | |
539 | interp' = getParent interp | |
540 | state' = setInterpreter state interp' | |
541 | state'' = statePush state' (Symbol ']') | |
542 | in | |
543 | do return state'' | |
544 | ||
545 | opSingleQuote state = | |
546 | let | |
547 | state' = setInterpreter state singleQuoteInterpreter | |
548 | in | |
549 | do return state' | |
550 | where | |
551 | singleQuoteInterpreter = Interp | |
552 | SingleQuote | |
553 | (Map.fromList | |
554 | [(sym, (Intrinsic sym (opPushAndRetreat sym))) | | |
555 | sym <- [(Char.chr 0) .. (Char.chr 255)]] | |
556 | ) | |
557 | (Intrinsic ' ' opNop) | |
558 | (getInterpreter state) | |
559 | ||
560 | ||
561 | ----------------------------------------------------------------------- | |
562 | -- ===================== Debugging Functions ======================= -- | |
563 | ----------------------------------------------------------------------- | |
564 | ||
565 | type Debugger = [Symbol] -> State -> IO () | |
566 | ||
567 | nullDebugger p s = do | |
568 | return () | |
569 | ||
570 | stdDebugger program@(instr:rest) state = do | |
571 | putStr "\n" | |
572 | putStr ("Instr: " ++ [instr] ++ "\n") | |
573 | putStr ("Rest: " ++ rest ++ "\n") | |
574 | putStr ("Stack: " ++ (show (stack state)) ++ "\n") | |
575 | putStr ("Interp: " ++ (show (interpreter state)) ++ "\n") | |
576 | putStr "(press ENTER) " | |
577 | control <- getCh state | |
578 | return () | |
579 | ||
580 | ||
581 | ----------------------------------------------------------------------- | |
582 | -- ====================== Top-Level Function ======================= -- | |
583 | ----------------------------------------------------------------------- | |
584 | ||
585 | initialInterpreter = Interp | |
586 | Initial | |
587 | (Map.fromList | |
588 | [ | |
589 | ('v', (Intrinsic 'v' opReify)), | |
590 | ('^', (Intrinsic '^' opDiefy)), | |
591 | ('>', (Intrinsic '>' opExtractOp)), | |
592 | ('<', (Intrinsic '<' opInstallOp)), | |
593 | ('{', (Intrinsic '{' opGetParent)), | |
594 | ('}', (Intrinsic '}' opSetParent)), | |
595 | ('*', (Intrinsic '*' opCreateOp)), | |
596 | ('@', (Intrinsic '@' opExpandOp)), | |
597 | ('!', (Intrinsic '!' opPerform)), | |
598 | ||
599 | ('0', (Intrinsic '0' opPushNullInterpreter)), | |
600 | ('1', (Intrinsic '1' opMakeUniformInterpreter)), | |
601 | ||
602 | ('[', (Intrinsic '[' opDescendQuote)), | |
603 | ('\'', (Intrinsic '\'' opSingleQuote)), | |
604 | ||
605 | ('.', (Intrinsic '.' opOutput)), | |
606 | (',', (Intrinsic ',' opInput)), | |
607 | ||
608 | (':', (Intrinsic ':' opDuplicate)), | |
609 | ('$', (Intrinsic '$' opDiscard)), | |
610 | ('/', (Intrinsic '/' opSwap)) | |
611 | ] | |
612 | ) | |
613 | (Intrinsic ' ' opNop) | |
614 | NoInterp | |
615 | ||
616 | initialState = State{ stack=(Stack []), interpreter=NoInterp, debugger=nullDebugger, getCh=getChar, putCh=putChar } | |
617 | ||
618 | runWith string state = | |
619 | execute (Program string initialInterpreter) state | |
620 | ||
621 | mascarpone string = | |
622 | runWith string initialState | |
623 | ||
624 | mascarponeWithIO getCh putCh string = | |
625 | runWith string initialState{ getCh=getCh, putCh=putCh } | |
626 | ||
627 | debug string = | |
628 | runWith string initialState{ debugger=stdDebugger } | |
629 | ||
630 | ||
631 | ----------------------------------------------------------------------- | |
632 | -- ========================== Test Cases =========================== -- | |
633 | ----------------------------------------------------------------------- | |
634 | ||
635 | -- | |
636 | -- Drivers for test cases. 'demo' runs them straight, whereas 'test' | |
637 | -- uses the debugger. | |
638 | -- | |
639 | ||
640 | demo n = mascarpone (testProg n) | |
641 | ||
642 | test n = debug (testProg n) | |
643 | ||
644 | ||
645 | -- | |
646 | -- Test nesting quotes. | |
647 | -- | |
648 | ||
649 | testProg 1 = "[o[ll]eh]........." | |
650 | ||
651 | -- | |
652 | -- Make a new operation, defined as ",.", and execute it. | |
653 | -- | |
654 | ||
655 | testProg 2 = "[,.]v*!" | |
656 | ||
657 | -- | |
658 | -- Redefine "&" as ",." in the current interpreter, and try it. | |
659 | -- | |
660 | ||
661 | testProg 3 = "v[,.]v*'&<^&&&" | |
662 | ||
663 | -- | |
664 | -- Like testProg 3, but restore the old interpreter afterwards. | |
665 | -- | |
666 | ||
667 | testProg 4 = "vv[,.]v*'&<^&&&^&&" | |
668 | ||
669 | -- | |
670 | -- Define an operation that modifies the caller's interpreter. | |
671 | -- The operation & causes m to be redefined as ",.". | |
672 | -- | |
673 | ||
674 | testProg 5 = "v[v{[,.]v*'m<v}^]v*'&<^mmmmm&mm" | |
675 | ||
676 | -- | |
677 | -- Execute an infinite loop. | |
678 | -- | |
679 | ||
680 | testProg 6 = "v[vv{'d>'d<^,.d]v*'d<^d" | |
681 | ||
682 | -- | |
683 | -- Execute an infinite loop, "tail-recursively". | |
684 | -- | |
685 | ||
686 | testProg 7 = "v[vv{'d>'d<^,.0v}^d]v*'d<^d" | |
687 | ||
688 | -- | |
689 | -- "Capture" a value in an operation: given a value, push | |
690 | -- an operation that pushes that value when executed. | |
691 | -- | |
692 | -- We want to push the string | |
693 | -- ['v] | |
694 | -- onto the stack, where v is the value we were given. So we: | |
695 | -- push [ | |
696 | -- swap | |
697 | -- push ' | |
698 | -- swap | |
699 | -- push ] | |
700 | -- Then we are ready to make the operation. | |
701 | -- | |
702 | ||
703 | testProg 8 = "v['[/''/']v*]v*'?<^'p?!." | |
704 | ||
705 | -- | |
706 | -- Treat an interpreter as a store. Define S to mean, | |
707 | -- pop a symbol, a value, and an interpreter, and push a new | |
708 | -- interpreter where the symbol means "push that value." | |
709 | -- Then define F to mean, pop a symbol and an interpreter, | |
710 | -- then extract the operation so named and run it (pushing | |
711 | -- the value stored.) | |
712 | -- | |
713 | ||
714 | testProg 9 = "v['[/''/']v*]v*'?<^v[/?/<]v*'S<[>!]v*'F<^[]v*1'p'kS'kF." | |
715 | ||
716 | -- | |
717 | -- Get whatever definition the interpreter sees fit to give | |
718 | -- us for a symbol input from the user, and output it. | |
719 | -- We define '?' as above first, and for the most interesting | |
720 | -- output (with this particular implementation ;) the user | |
721 | -- should enter '?' when the time comes for ',' to execute... | |
722 | -- | |
723 | ||
724 | testProg 10 = "v['[/''/']v*]v*'?<^v,>@$............" | |
725 | ||
726 | -- | |
727 | -- Demonstrates how one can use * after @. | |
728 | -- | |
729 | ||
730 | testProg 11 = "v['[/''/']v*]v*'?<^vv'?>@$v*'?<^'k?!." | |
731 | ||
732 | -- | |
733 | -- Demonstrate that we cannot make an interpreter which is | |
734 | -- its own parent. Setting the parent of an interpreter | |
735 | -- does not modify that interpreter; it produces a copy. | |
736 | -- | |
737 | ||
738 | testProg 12 = "vv}^'k." |
0 | 0 | module Main where |
1 | 1 | |
2 | 2 | import System.Environment |
3 | import Mascarpone | |
4 | ||
5 | showState (State s _ _) = (show s) | |
3 | import Language.Mascarpone (mascarpone, debug, getStack) | |
6 | 4 | |
7 | 5 | main = do |
8 | 6 | args <- getArgs |
18 | 16 | ["-r", fileName] -> do |
19 | 17 | c <- readFile fileName |
20 | 18 | r <- mascarpone c |
21 | putStrLn (showState r) | |
19 | putStrLn $ show $ getStack r | |
22 | 20 | _ -> do |
23 | 21 | putStrLn "Usage: mascarpone [-d|-r] <filename.mascarpone>" |
0 | -- | |
1 | -- Copyright (c)2007-2014 Chris Pressey, Cat's Eye Technologies. | |
2 | -- All rights reserved. | |
3 | -- | |
4 | -- Redistribution and use in source and binary forms, with or without | |
5 | -- modification, are permitted provided that the following conditions | |
6 | -- are met: | |
7 | -- | |
8 | -- 1. Redistributions of source code must retain the above copyright | |
9 | -- notices, this list of conditions and the following disclaimer. | |
10 | -- 2. Redistributions in binary form must reproduce the above copyright | |
11 | -- notices, this list of conditions, and the following disclaimer in | |
12 | -- the documentation and/or other materials provided with the | |
13 | -- distribution. | |
14 | -- 3. Neither the names of the copyright holders nor the names of their | |
15 | -- contributors may be used to endorse or promote products derived | |
16 | -- from this software without specific prior written permission. | |
17 | -- | |
18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |
19 | -- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT | |
20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS | |
21 | -- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE | |
22 | -- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, | |
23 | -- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, | |
24 | -- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; | |
25 | -- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | |
26 | -- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | |
27 | -- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN | |
28 | -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE | |
29 | -- POSSIBILITY OF SUCH DAMAGE. | |
30 | -- | |
31 | ||
32 | -- | |
33 | -- mascarpone.hs v2007.1208 | |
34 | -- $Id: mascarpone.hs 16 2007-12-09 00:20:53Z catseye $ | |
35 | -- | |
36 | -- Reference interpreter for | |
37 | -- The Mascarpone Programming Language | |
38 | -- v1.0 | |
39 | -- | |
40 | ||
41 | module Mascarpone where | |
42 | ||
43 | import qualified Data.Map as Map | |
44 | import qualified Data.Char as Char | |
45 | ||
46 | ----------------------------------------------------------------------- | |
47 | -- ============================ Symbols ============================ -- | |
48 | ----------------------------------------------------------------------- | |
49 | ||
50 | type Symbol = Char | |
51 | ||
52 | ||
53 | ----------------------------------------------------------------------- | |
54 | -- ============================== Data ============================= -- | |
55 | ----------------------------------------------------------------------- | |
56 | ||
57 | data Datum = Symbol Symbol | |
58 | | Operation Operation | |
59 | | Interpreter Interpreter | |
60 | deriving (Show) | |
61 | ||
62 | ||
63 | ----------------------------------------------------------------------- | |
64 | -- ============================= Stacks ============================ -- | |
65 | ----------------------------------------------------------------------- | |
66 | ||
67 | data Stack = Stack [Datum] | |
68 | ||
69 | instance Show Stack where | |
70 | show (Stack datumList) = | |
71 | "[(bottom) " ++ showStack (reverse datumList) ++ "(top)]" | |
72 | ||
73 | showStack [] = "" | |
74 | showStack ((Symbol sym):tail) = "'" ++ [sym] ++ "' " ++ (showStack tail) | |
75 | showStack ((Operation op):tail) = (show op) ++ " " ++ (showStack tail) | |
76 | showStack ((Interpreter i):tail) = (show i) ++ " " ++ (showStack tail) | |
77 | showStack (head:tail) = (show head) ++ " " ++ (showStack tail) | |
78 | ||
79 | pop (Stack (head:tail)) = (head, Stack tail) | |
80 | push (Stack tail) head = (Stack (head:tail)) | |
81 | ||
82 | pushString stack string = pushString' stack ("[" ++ string ++ "]") | |
83 | pushString' stack [] = stack | |
84 | pushString' stack (head:tail) = | |
85 | let | |
86 | stack' = push stack (Symbol head) | |
87 | in | |
88 | pushString' stack' tail | |
89 | ||
90 | popString (Stack ((Symbol ']'):tail)) = popString' (Stack tail) 0 | |
91 | ||
92 | popString' (Stack ((Symbol ']'):tail)) level = | |
93 | let | |
94 | (string, stack') = popString' (Stack tail) (level + 1) | |
95 | in | |
96 | (string ++ [']'], stack') | |
97 | popString' (Stack ((Symbol '['):tail)) 0 = ([], Stack tail) | |
98 | popString' (Stack ((Symbol '['):tail)) level = | |
99 | let | |
100 | (string, stack') = popString' (Stack tail) (level - 1) | |
101 | in | |
102 | (string ++ ['['], stack') | |
103 | popString' (Stack ((Symbol head):tail)) level = | |
104 | let | |
105 | (string, stack') = popString' (Stack tail) level | |
106 | in | |
107 | (string ++ [head], stack') | |
108 | ||
109 | ||
110 | ----------------------------------------------------------------------- | |
111 | -- ======================== Program States ========================= -- | |
112 | ----------------------------------------------------------------------- | |
113 | ||
114 | data State = State Stack Interpreter Debugger | |
115 | ||
116 | getInterpreter (State _ i _) = i | |
117 | setInterpreter (State s _ d) i = State s i d | |
118 | ||
119 | statePush (State s i d) head = State (push s head) i d | |
120 | statePushString (State s i d) str = State (pushString s str) i d | |
121 | ||
122 | statePop (State s i d) = | |
123 | let | |
124 | (elem, s') = pop s | |
125 | in | |
126 | (elem, (State s' i d)) | |
127 | statePopString (State s i d) = | |
128 | let | |
129 | (string, s') = popString s | |
130 | in | |
131 | (string, (State s' i d)) | |
132 | ||
133 | stateDebug program state@(State _ _ debugger) = | |
134 | debugger program state | |
135 | ||
136 | ||
137 | ----------------------------------------------------------------------- | |
138 | -- ========================= Interpreters ========================== -- | |
139 | ----------------------------------------------------------------------- | |
140 | ||
141 | -- | |
142 | -- An interpreter maps symbols onto operations. The map is given as a | |
143 | -- finite function (a finite set of pairs of symbols and operations,) | |
144 | -- plus an operation which is the "default" which is assumed when there | |
145 | -- is no explicit operation present for a given symbol. Each interpreter | |
146 | -- also has a "parent" interpreter, which may be null (NoInterp.) | |
147 | -- | |
148 | ||
149 | data InterpreterSort = Initial | |
150 | | DeepQuote | |
151 | | SingleQuote | |
152 | | Custom | |
153 | ||
154 | data Interpreter = Interp InterpreterSort (Map.Map Symbol Operation) Operation Interpreter | |
155 | | NoInterp | |
156 | ||
157 | instance Show Interpreter where | |
158 | show (Interp Initial _ _ parent) = | |
159 | "|Initial|->" ++ (show parent) | |
160 | show (Interp DeepQuote _ _ parent) = | |
161 | "|DeepQuote|->" ++ (show parent) | |
162 | show (Interp SingleQuote _ _ parent) = | |
163 | "|SingleQuote|->" ++ (show parent) | |
164 | show (Interp Custom map def parent) = | |
165 | "|" ++ (show map) ++ ", default=" ++ (show def) ++ "|->" ++ (show parent) | |
166 | show NoInterp = | |
167 | "|None|" | |
168 | ||
169 | -- | |
170 | -- Retrieve the operation associated with the given symbol. | |
171 | -- | |
172 | ||
173 | fetch (Interp _ map def _) sym = Map.findWithDefault def sym map | |
174 | ||
175 | -- | |
176 | -- Return a derived interpreter where the given symbol is associated | |
177 | -- with the given operation. | |
178 | -- | |
179 | ||
180 | supplant (Interp _ map def parent) sym op = (Interp Custom (Map.insert sym op map) def parent) | |
181 | ||
182 | -- | |
183 | -- Retrieve the parent interpreter of the given interpreter. | |
184 | -- | |
185 | ||
186 | getParent (Interp _ _ _ parent) = parent | |
187 | ||
188 | -- | |
189 | -- Return a derived interpreter where the parent interpreter is the given | |
190 | -- interpreter. | |
191 | -- | |
192 | ||
193 | setParent (Interp sort map def _) parent = Interp sort map def parent | |
194 | ||
195 | ||
196 | ----------------------------------------------------------------------- | |
197 | -- ========================== Operations =========================== -- | |
198 | ----------------------------------------------------------------------- | |
199 | ||
200 | -- | |
201 | -- An operation is a string of symbols given meaning by an interpreter. | |
202 | -- | |
203 | -- Of course, that definition is more conceptual than practical; | |
204 | -- in this implementation, we also have Intrinsic operations, which are | |
205 | -- part of the inital Mascarpone interpreter, and are defined by | |
206 | -- Haskell functions. | |
207 | -- | |
208 | -- The Symbol in the Intrinsic alternative is only for aesthetic | |
209 | -- purposes: it indicates what symbol is associated with the | |
210 | -- operation in the initial Mascarpone interpreter, so that Show | |
211 | -- Operation, and the result of expandOp, are somewhat more human- | |
212 | -- friendly. However, it is semantically immaterial. | |
213 | -- | |
214 | ||
215 | data Operation = Intrinsic Symbol (State -> IO State) | |
216 | | Program [Symbol] Interpreter | |
217 | ||
218 | instance Show Operation where | |
219 | show (Intrinsic sym _) = "[[intrinsic '" ++ [sym] ++ "']]" | |
220 | show (Program string interpreter) = "[[" ++ show string ++ "/" ++ show interpreter ++ "]]" | |
221 | ||
222 | -- | |
223 | -- Execute the given operation in the given state. | |
224 | -- | |
225 | ||
226 | execute :: Operation -> State -> IO State | |
227 | ||
228 | execute (Intrinsic _ f) state = | |
229 | f state | |
230 | ||
231 | -- | |
232 | -- Note that when we call an operation that was defined using a "captured" | |
233 | -- interpreter, we do the following: | |
234 | -- | |
235 | -- 1. We attach the current interpreter as the parent interpreter of the | |
236 | -- captured interpreter | |
237 | -- 2. We interpret the symbols in the operation definition using the captured | |
238 | -- interpreter | |
239 | -- 3. When we have reached the end, we extract the parent interpreter of the | |
240 | -- captured interpreter and use it as the new current interpreter | |
241 | -- | |
242 | -- Note that this means two things: | |
243 | -- | |
244 | -- 1. The operation definition may modify its current interpreter (the | |
245 | -- captured interpreter) to its heart's content; this will not modify | |
246 | -- our current interpreter (the parent interpreter) | |
247 | -- 2. The operation definition may modify our current interpreter by | |
248 | -- modifying the parent interpreter of its current interpreter. | |
249 | -- | |
250 | ||
251 | execute (Program programText capturedInterpreter) state = | |
252 | let | |
253 | callersInterpreter = getInterpreter state | |
254 | capturedInterpreter' = setParent capturedInterpreter callersInterpreter | |
255 | state' = setInterpreter state capturedInterpreter' | |
256 | in | |
257 | execute' programText state' | |
258 | ||
259 | execute' [] state = | |
260 | let | |
261 | capturedInterpreter = getInterpreter state | |
262 | callersInterpreter = getParent capturedInterpreter | |
263 | state' = setInterpreter state callersInterpreter | |
264 | in | |
265 | do return state' | |
266 | ||
267 | execute' program@(symbol:tail) state = | |
268 | let | |
269 | interpreter = getInterpreter state | |
270 | operation = fetch interpreter symbol | |
271 | in do | |
272 | stateDebug program state | |
273 | state' <- execute operation state | |
274 | execute' tail state' | |
275 | ||
276 | -- | |
277 | -- Expand an operation into a program (string of symbols) and an | |
278 | -- interpreter, such that the string of symbols, when interpreted | |
279 | -- by that interpreter, does the same things as the operation. | |
280 | -- | |
281 | -- This happens to return, for program-defined operations, the same | |
282 | -- program and interpreter that the operation was created using, | |
283 | -- and for intrinsic operations, the program consisting only of | |
284 | -- the symbol used for that intrinsic operation in the inital | |
285 | -- Mascarpone interpreter, plus the initial Mascarpone interpreter. | |
286 | -- However, there are an infinite number of other possible correct | |
287 | -- returns. | |
288 | -- | |
289 | ||
290 | expandOp :: Operation -> ([Symbol], Interpreter) | |
291 | ||
292 | expandOp (Program str interp) = | |
293 | (str, interp) | |
294 | expandOp (Intrinsic sym _) = | |
295 | let | |
296 | prog = [sym] | |
297 | in | |
298 | (prog, initialInterpreter) | |
299 | ||
300 | ||
301 | ------------------------------------------------------------ | |
302 | --------------- The operations themselves. ----------------- | |
303 | ------------------------------------------------------------ | |
304 | ||
305 | ||
306 | -- | |
307 | -- Miscellaneous operations. | |
308 | -- | |
309 | ||
310 | -- | |
311 | -- Do nothing. | |
312 | -- | |
313 | ||
314 | opNop state = | |
315 | do return state | |
316 | ||
317 | -- | |
318 | -- Push the null interpreter onto the stack. | |
319 | -- | |
320 | ||
321 | opPushNullInterpreter state = | |
322 | do return (statePush state (Interpreter NoInterp)) | |
323 | ||
324 | -- | |
325 | -- Pop an operation, create an interpreter where all symbols | |
326 | -- are associated with that operation, and push that interpreter | |
327 | -- onto the stack. | |
328 | -- | |
329 | ||
330 | opMakeUniformInterpreter state = | |
331 | let | |
332 | ((Operation op), state') = statePop state | |
333 | interpreter = Interp Custom Map.empty op NoInterp | |
334 | in | |
335 | do return (statePush state' (Interpreter interpreter)) | |
336 | ||
337 | -- | |
338 | -- Push the current interpreter onto the stack. | |
339 | -- | |
340 | ||
341 | opReify state = | |
342 | let | |
343 | interpreter = getInterpreter state | |
344 | state' = statePush state (Interpreter interpreter) | |
345 | in | |
346 | do return state' | |
347 | ||
348 | -- | |
349 | -- Pop an interpreter from the stack and use it to interpret | |
350 | -- the remainder of the program. | |
351 | -- | |
352 | ||
353 | opDiefy state = | |
354 | let | |
355 | ((Interpreter interpreter), state') = statePop state | |
356 | state'' = setInterpreter state' interpreter | |
357 | in | |
358 | do return state'' | |
359 | ||
360 | -- | |
361 | -- Pop an interpreter from the stack, and push back onto | |
362 | -- the stack the interpreter's parent interpreter. | |
363 | -- | |
364 | ||
365 | opGetParent state = | |
366 | let | |
367 | ((Interpreter interpreter), state') = statePop state | |
368 | state'' = statePush state' (Interpreter (getParent interpreter)) | |
369 | in | |
370 | do return state'' | |
371 | ||
372 | -- | |
373 | -- Pop an interpreter i from the stack, then another interpreter j. | |
374 | -- Push a new interpreter that is the same as i, but has j as its parent. | |
375 | -- | |
376 | -- So the stack looks like this: newParent oldInterp -> newInterp | |
377 | -- | |
378 | ||
379 | opSetParent state = | |
380 | let | |
381 | ((Interpreter interpreter), state') = statePop state | |
382 | ((Interpreter parent), state'') = statePop state' | |
383 | interpreter' = setParent interpreter parent | |
384 | state''' = statePush state'' (Interpreter interpreter') | |
385 | in | |
386 | do return state''' | |
387 | ||
388 | -- | |
389 | -- Pop a symbol and an interpreter and push the operation that | |
390 | -- corresponds with that symbol in that interpreter. | |
391 | -- | |
392 | ||
393 | opExtractOp state = | |
394 | let | |
395 | ((Symbol sym), state') = statePop state | |
396 | ((Interpreter interp), state'') = statePop state' | |
397 | op = fetch interp sym | |
398 | state''' = statePush state'' (Operation op) | |
399 | in | |
400 | do return state''' | |
401 | ||
402 | -- | |
403 | -- Pop a symbol, an operation, and an interpreter, and push a new | |
404 | -- interpreter in which that symbol is associated with that operation. | |
405 | -- | |
406 | ||
407 | opInstallOp state = | |
408 | let | |
409 | ((Symbol sym), state') = statePop state | |
410 | ((Operation op), state'') = statePop state' | |
411 | ((Interpreter interp), state''') = statePop state'' | |
412 | interp' = supplant interp sym op | |
413 | state'''' = statePush state''' (Interpreter interp') | |
414 | in | |
415 | do return state'''' | |
416 | ||
417 | -- | |
418 | -- Pop an operation from the stack and perform it. | |
419 | -- | |
420 | ||
421 | opPerform state = | |
422 | let | |
423 | ((Operation op), state') = statePop state | |
424 | in | |
425 | execute op state' | |
426 | ||
427 | -- | |
428 | -- Pop an interpreter and a program from the stack and | |
429 | -- compose an operation that has the effect of running | |
430 | -- that program on that interpreter. | |
431 | -- | |
432 | ||
433 | opCreateOp state = | |
434 | let | |
435 | ((Interpreter interp), state') = statePop state | |
436 | (string, state'') = statePopString state' | |
437 | op = Program string interp | |
438 | state''' = statePush state'' (Operation op) | |
439 | in | |
440 | do return state''' | |
441 | ||
442 | -- | |
443 | -- Pop an operation from the stack and push a program, | |
444 | -- then an interpreter, onto the stack. The semantics | |
445 | -- of running that program with that interpreter will | |
446 | -- be identical to the semantics of executing the operation. | |
447 | -- However, the operation need not have been defined with | |
448 | -- that program or that interpreter. (This means one can | |
449 | -- sensibly expand intrinsic operations.) | |
450 | -- | |
451 | ||
452 | opExpandOp state = | |
453 | let | |
454 | ((Operation op), state') = statePop state | |
455 | (prog, interp) = expandOp op | |
456 | state'' = statePushString state' prog | |
457 | state''' = statePush state'' (Interpreter interp) | |
458 | in | |
459 | do return state''' | |
460 | ||
461 | ||
462 | -- | |
463 | -- Stack manipulation. | |
464 | -- | |
465 | ||
466 | -- | |
467 | -- Discard the top element of the stack. | |
468 | -- | |
469 | ||
470 | opDiscard state = | |
471 | let | |
472 | (_, state') = statePop state | |
473 | in | |
474 | do return state' | |
475 | ||
476 | -- | |
477 | -- Duplicate the top element of the stack. | |
478 | -- | |
479 | ||
480 | opDuplicate state = | |
481 | let | |
482 | (elem, _) = statePop state | |
483 | state' = statePush state elem | |
484 | in | |
485 | do return state' | |
486 | ||
487 | -- | |
488 | -- Swaps the top two elements of the stack. | |
489 | -- | |
490 | ||
491 | opSwap state = | |
492 | let | |
493 | (elem_top, state') = statePop state | |
494 | (elem_bot, state'') = statePop state' | |
495 | state''' = statePush state'' elem_top | |
496 | state'''' = statePush state''' elem_bot | |
497 | in | |
498 | do return state'''' | |
499 | ||
500 | -- | |
501 | -- I/O. | |
502 | -- | |
503 | ||
504 | opInput state = do | |
505 | symbol <- getChar | |
506 | return (statePush state (Symbol symbol)) | |
507 | ||
508 | opOutput state = | |
509 | let | |
510 | ((Symbol symbol), state') = statePop state | |
511 | in do | |
512 | putChar symbol | |
513 | return state' | |
514 | ||
515 | -- | |
516 | -- Parameterizable operations. | |
517 | -- | |
518 | ||
519 | opPushValue value state = | |
520 | do return (statePush state value) | |
521 | ||
522 | opPushSymbol symbol state = | |
523 | opPushValue (Symbol symbol) state | |
524 | ||
525 | opPushAndRetreat symbol state = | |
526 | let | |
527 | state' = statePush state (Symbol symbol) | |
528 | interp = getInterpreter state' | |
529 | interp' = getParent interp | |
530 | state'' = setInterpreter state' interp' | |
531 | in | |
532 | do return state'' | |
533 | ||
534 | -- | |
535 | -- Quote stuff. | |
536 | -- | |
537 | ||
538 | opDescendQuote state = | |
539 | let | |
540 | state' = setInterpreter state deepQuoteInterpreter | |
541 | state'' = statePush state' (Symbol '[') | |
542 | in | |
543 | do return state'' | |
544 | where | |
545 | deepQuoteInterpreter = Interp | |
546 | DeepQuote | |
547 | (Map.fromList | |
548 | ([(sym, (Intrinsic sym (opPushSymbol sym))) | | |
549 | sym <- [(Char.chr 0) .. (Char.chr 255)]] | |
550 | ++ | |
551 | [('[', (Intrinsic '[' opDescendQuote)), | |
552 | (']', (Intrinsic ']' opAscendQuote))]) | |
553 | ) | |
554 | (Intrinsic ' ' opNop) | |
555 | (getInterpreter state) | |
556 | ||
557 | opAscendQuote state = | |
558 | let | |
559 | interp = getInterpreter state | |
560 | interp' = getParent interp | |
561 | state' = setInterpreter state interp' | |
562 | state'' = statePush state' (Symbol ']') | |
563 | in | |
564 | do return state'' | |
565 | ||
566 | opSingleQuote state = | |
567 | let | |
568 | state' = setInterpreter state singleQuoteInterpreter | |
569 | in | |
570 | do return state' | |
571 | where | |
572 | singleQuoteInterpreter = Interp | |
573 | SingleQuote | |
574 | (Map.fromList | |
575 | [(sym, (Intrinsic sym (opPushAndRetreat sym))) | | |
576 | sym <- [(Char.chr 0) .. (Char.chr 255)]] | |
577 | ) | |
578 | (Intrinsic ' ' opNop) | |
579 | (getInterpreter state) | |
580 | ||
581 | ||
582 | ----------------------------------------------------------------------- | |
583 | -- ===================== Debugging Functions ======================= -- | |
584 | ----------------------------------------------------------------------- | |
585 | ||
586 | type Debugger = [Symbol] -> State -> IO () | |
587 | ||
588 | nullDebugger p s = do | |
589 | return () | |
590 | ||
591 | stdDebugger program@(instr:rest) (State s i d) = do | |
592 | putStr "\n" | |
593 | putStr ("Instr: " ++ [instr] ++ "\n") | |
594 | putStr ("Rest: " ++ rest ++ "\n") | |
595 | putStr ("Stack: " ++ (show s) ++ "\n") | |
596 | putStr ("Interp: " ++ (show i) ++ "\n") | |
597 | putStr "(press ENTER) " | |
598 | control <- getChar | |
599 | return () | |
600 | ||
601 | ||
602 | ----------------------------------------------------------------------- | |
603 | -- ====================== Top-Level Function ======================= -- | |
604 | ----------------------------------------------------------------------- | |
605 | ||
606 | initialInterpreter = Interp | |
607 | Initial | |
608 | (Map.fromList | |
609 | [ | |
610 | ('v', (Intrinsic 'v' opReify)), | |
611 | ('^', (Intrinsic '^' opDiefy)), | |
612 | ('>', (Intrinsic '>' opExtractOp)), | |
613 | ('<', (Intrinsic '<' opInstallOp)), | |
614 | ('{', (Intrinsic '{' opGetParent)), | |
615 | ('}', (Intrinsic '}' opSetParent)), | |
616 | ('*', (Intrinsic '*' opCreateOp)), | |
617 | ('@', (Intrinsic '@' opExpandOp)), | |
618 | ('!', (Intrinsic '!' opPerform)), | |
619 | ||
620 | ('0', (Intrinsic '0' opPushNullInterpreter)), | |
621 | ('1', (Intrinsic '1' opMakeUniformInterpreter)), | |
622 | ||
623 | ('[', (Intrinsic '[' opDescendQuote)), | |
624 | ('\'', (Intrinsic '\'' opSingleQuote)), | |
625 | ||
626 | ('.', (Intrinsic '.' opOutput)), | |
627 | (',', (Intrinsic ',' opInput)), | |
628 | ||
629 | (':', (Intrinsic ':' opDuplicate)), | |
630 | ('$', (Intrinsic '$' opDiscard)), | |
631 | ('/', (Intrinsic '/' opSwap)) | |
632 | ] | |
633 | ) | |
634 | (Intrinsic ' ' opNop) | |
635 | NoInterp | |
636 | ||
637 | runWith string debugger = | |
638 | let | |
639 | initialState = (State (Stack []) NoInterp debugger) | |
640 | in | |
641 | execute (Program string initialInterpreter) initialState | |
642 | ||
643 | mascarpone string = | |
644 | runWith string nullDebugger | |
645 | ||
646 | debug string = | |
647 | runWith string stdDebugger | |
648 | ||
649 | ||
650 | ----------------------------------------------------------------------- | |
651 | -- ========================== Test Cases =========================== -- | |
652 | ----------------------------------------------------------------------- | |
653 | ||
654 | -- | |
655 | -- Drivers for test cases. 'demo' runs them straight, whereas 'test' | |
656 | -- uses the debugger. | |
657 | -- | |
658 | ||
659 | demo n = mascarpone (testProg n) | |
660 | ||
661 | test n = debug (testProg n) | |
662 | ||
663 | ||
664 | -- | |
665 | -- Test nesting quotes. | |
666 | -- | |
667 | ||
668 | testProg 1 = "[o[ll]eh]........." | |
669 | ||
670 | -- | |
671 | -- Make a new operation, defined as ",.", and execute it. | |
672 | -- | |
673 | ||
674 | testProg 2 = "[,.]v*!" | |
675 | ||
676 | -- | |
677 | -- Redefine "&" as ",." in the current interpreter, and try it. | |
678 | -- | |
679 | ||
680 | testProg 3 = "v[,.]v*'&<^&&&" | |
681 | ||
682 | -- | |
683 | -- Like testProg 3, but restore the old interpreter afterwards. | |
684 | -- | |
685 | ||
686 | testProg 4 = "vv[,.]v*'&<^&&&^&&" | |
687 | ||
688 | -- | |
689 | -- Define an operation that modifies the caller's interpreter. | |
690 | -- The operation & causes m to be redefined as ",.". | |
691 | -- | |
692 | ||
693 | testProg 5 = "v[v{[,.]v*'m<v}^]v*'&<^mmmmm&mm" | |
694 | ||
695 | -- | |
696 | -- Execute an infinite loop. | |
697 | -- | |
698 | ||
699 | testProg 6 = "v[vv{'d>'d<^,.d]v*'d<^d" | |
700 | ||
701 | -- | |
702 | -- Execute an infinite loop, "tail-recursively". | |
703 | -- | |
704 | ||
705 | testProg 7 = "v[vv{'d>'d<^,.0v}^d]v*'d<^d" | |
706 | ||
707 | -- | |
708 | -- "Capture" a value in an operation: given a value, push | |
709 | -- an operation that pushes that value when executed. | |
710 | -- | |
711 | -- We want to push the string | |
712 | -- ['v] | |
713 | -- onto the stack, where v is the value we were given. So we: | |
714 | -- push [ | |
715 | -- swap | |
716 | -- push ' | |
717 | -- swap | |
718 | -- push ] | |
719 | -- Then we are ready to make the operation. | |
720 | -- | |
721 | ||
722 | testProg 8 = "v['[/''/']v*]v*'?<^'p?!." | |
723 | ||
724 | -- | |
725 | -- Treat an interpreter as a store. Define S to mean, | |
726 | -- pop a symbol, a value, and an interpreter, and push a new | |
727 | -- interpreter where the symbol means "push that value." | |
728 | -- Then define F to mean, pop a symbol and an interpreter, | |
729 | -- then extract the operation so named and run it (pushing | |
730 | -- the value stored.) | |
731 | -- | |
732 | ||
733 | testProg 9 = "v['[/''/']v*]v*'?<^v[/?/<]v*'S<[>!]v*'F<^[]v*1'p'kS'kF." | |
734 | ||
735 | -- | |
736 | -- Get whatever definition the interpreter sees fit to give | |
737 | -- us for a symbol input from the user, and output it. | |
738 | -- We define '?' as above first, and for the most interesting | |
739 | -- output (with this particular implementation ;) the user | |
740 | -- should enter '?' when the time comes for ',' to execute... | |
741 | -- | |
742 | ||
743 | testProg 10 = "v['[/''/']v*]v*'?<^v,>@$............" | |
744 | ||
745 | -- | |
746 | -- Demonstrates how one can use * after @. | |
747 | -- | |
748 | ||
749 | testProg 11 = "v['[/''/']v*]v*'?<^vv'?>@$v*'?<^'k?!." | |
750 | ||
751 | -- | |
752 | -- Demonstrate that we cannot make an interpreter which is | |
753 | -- its own parent. Setting the parent of an interpreter | |
754 | -- does not modify that interpreter; it produces a copy. | |
755 | -- | |
756 | ||
757 | testProg 12 = "vv}^'k." |
1 | 1 | |
2 | 2 | ./build.sh || exit 1 |
3 | 3 | |
4 | falderal --substring-error tests/Mascarpone.markdown | |
4 | falderal --substring-error tests/Mascarpone.md |
0 | Test Suite for Mascarpone | |
1 | ========================= | |
2 | ||
3 | This test suite is written in the format of Falderal 0.9. It is far from | |
4 | exhaustive, but provides a basic sanity check on the language. | |
5 | ||
6 | Mascarpone Tests | |
7 | ---------------- | |
8 | ||
9 | -> Functionality "Interpret Mascarpone Program" is implemented by | |
10 | -> shell command | |
11 | -> "bin/mascarpone %(test-body-file)" | |
12 | ||
13 | -> Functionality "Interpret Mascarpone Program and Show Final State" | |
14 | -> is implemented by shell command | |
15 | -> "bin/mascarpone -r %(test-body-file)" | |
16 | ||
17 | -> Tests for functionality "Interpret Mascarpone Program" | |
18 | ||
19 | Test nesting quotes. | |
20 | ||
21 | | [o[ll]eh]......... | |
22 | = ]he]ll[o[ | |
23 | ||
24 | Make a new operation, defined as `,.`, and execute it. | |
25 | ||
26 | | [,.]v*! | |
27 | + Z | |
28 | = Z | |
29 | ||
30 | Redefine `&` as `,.` in the current interpreter, and try it. | |
31 | ||
32 | | v[,.]v*'&<^&&& | |
33 | + Zil | |
34 | = Zil | |
35 | ||
36 | Like the previous, but restore the old interpreter afterwards. | |
37 | ||
38 | | vv[,.]v*'&<^&&&^&& | |
39 | + Zam | |
40 | = Zam | |
41 | ||
42 | Define an operation that modifies the caller's interpreter. | |
43 | The operation `&` causes `m` to be redefined as `,.`. | |
44 | ||
45 | | v[v{[,.]v*'m<v}^]v*'&<^mmmmm&mm | |
46 | + ZK | |
47 | = ZK | |
48 | ||
49 | "Capture" a value in an operation: given a value, push | |
50 | an operation that pushes that value when executed. | |
51 | ||
52 | We want to push the string | |
53 | ||
54 | ['v] | |
55 | ||
56 | onto the stack, where v is the value we were given. So we: | |
57 | ||
58 | push [ | |
59 | swap | |
60 | push ' | |
61 | swap | |
62 | push ] | |
63 | ||
64 | Then we are ready to make the operation. | |
65 | ||
66 | | v['[/''/']v*]v*'?<^'p?!. | |
67 | = p | |
68 | ||
69 | Treat an interpreter as a store. Define `S` to mean, | |
70 | pop a symbol, a value, and an interpreter, and push a new | |
71 | interpreter where the symbol means "push that value." | |
72 | Then define `F` to mean, pop a symbol and an interpreter, | |
73 | then extract the operation so named and run it (pushing | |
74 | the value stored.) | |
75 | ||
76 | | v['[/''/']v*]v*'?<^v[/?/<]v*'S<[>!]v*'F<^[]v*1'p'kS'kF. | |
77 | = p | |
78 | ||
79 | Get whatever definition the interpreter sees fit to give | |
80 | us for a symbol input from the user, and output it. We | |
81 | define `?` as above, and then inquire as to the definition | |
82 | of `?`. | |
83 | ||
84 | (Note that the reified definitions of symbols are implementation- | |
85 | specific, and therefore that this test is *non*-normative with | |
86 | respect to the Mascarpone language itself.) | |
87 | ||
88 | | v['[/''/']v*]v*'?<^v,>@$............ | |
89 | + ? | |
90 | = ]*v]'/''/['[ | |
91 | ||
92 | Demonstrate how one can use `*` after `@`. | |
93 | ||
94 | | v['[/''/']v*]v*'?<^vv'?>@$v*'?<^'k?!. | |
95 | = k | |
96 | ||
97 | Demonstrate that we cannot make an interpreter which is | |
98 | its own parent. Setting the parent of an interpreter | |
99 | does not modify that interpreter; it produces a copy. | |
100 | ||
101 | | vv}^'k. | |
102 | = k |
0 | Test Suite for Mascarpone | |
1 | ========================= | |
2 | ||
3 | This test suite is written in the format of Falderal 0.9. It is far from | |
4 | exhaustive, but provides a basic sanity check on the language. | |
5 | ||
6 | Mascarpone Tests | |
7 | ---------------- | |
8 | ||
9 | -> Functionality "Interpret Mascarpone Program" is implemented by | |
10 | -> shell command | |
11 | -> "bin/mascarpone %(test-body-file)" | |
12 | ||
13 | -> Functionality "Interpret Mascarpone Program and Show Final State" | |
14 | -> is implemented by shell command | |
15 | -> "bin/mascarpone -r %(test-body-file)" | |
16 | ||
17 | -> Tests for functionality "Interpret Mascarpone Program" | |
18 | ||
19 | Test nesting quotes. | |
20 | ||
21 | | [o[ll]eh]......... | |
22 | = ]he]ll[o[ | |
23 | ||
24 | Make a new operation, defined as `,.`, and execute it. | |
25 | ||
26 | | [,.]v*! | |
27 | + Z | |
28 | = Z | |
29 | ||
30 | Redefine `&` as `,.` in the current interpreter, and try it. | |
31 | ||
32 | | v[,.]v*'&<^&&& | |
33 | + Zil | |
34 | = Zil | |
35 | ||
36 | Like the previous, but restore the old interpreter afterwards. | |
37 | ||
38 | | vv[,.]v*'&<^&&&^&& | |
39 | + Zam | |
40 | = Zam | |
41 | ||
42 | Define an operation that modifies the caller's interpreter. | |
43 | The operation `&` causes `m` to be redefined as `,.`. | |
44 | ||
45 | | v[v{[,.]v*'m<v}^]v*'&<^mmmmm&mm | |
46 | + ZK | |
47 | = ZK | |
48 | ||
49 | "Capture" a value in an operation: given a value, push | |
50 | an operation that pushes that value when executed. | |
51 | ||
52 | We want to push the string | |
53 | ||
54 | ['v] | |
55 | ||
56 | onto the stack, where v is the value we were given. So we: | |
57 | ||
58 | push [ | |
59 | swap | |
60 | push ' | |
61 | swap | |
62 | push ] | |
63 | ||
64 | Then we are ready to make the operation. | |
65 | ||
66 | | v['[/''/']v*]v*'?<^'p?!. | |
67 | = p | |
68 | ||
69 | Treat an interpreter as a store. Define `S` to mean, | |
70 | pop a symbol, a value, and an interpreter, and push a new | |
71 | interpreter where the symbol means "push that value." | |
72 | Then define `F` to mean, pop a symbol and an interpreter, | |
73 | then extract the operation so named and run it (pushing | |
74 | the value stored.) | |
75 | ||
76 | | v['[/''/']v*]v*'?<^v[/?/<]v*'S<[>!]v*'F<^[]v*1'p'kS'kF. | |
77 | = p | |
78 | ||
79 | Get whatever definition the interpreter sees fit to give | |
80 | us for a symbol input from the user, and output it. We | |
81 | define `?` as above, and then inquire as to the definition | |
82 | of `?`. | |
83 | ||
84 | (Note that the reified definitions of symbols are implementation- | |
85 | specific, and therefore that this test is *non*-normative with | |
86 | respect to the Mascarpone language itself.) | |
87 | ||
88 | | v['[/''/']v*]v*'?<^v,>@$............ | |
89 | + ? | |
90 | = ]*v]'/''/['[ | |
91 | ||
92 | Demonstrate how one can use `*` after `@`. | |
93 | ||
94 | | v['[/''/']v*]v*'?<^vv'?>@$v*'?<^'k?!. | |
95 | = k | |
96 | ||
97 | Demonstrate that we cannot make an interpreter which is | |
98 | its own parent. Setting the parent of an interpreter | |
99 | does not modify that interpreter; it produces a copy. | |
100 | ||
101 | | vv}^'k. | |
102 | = k |