diff --git a/README.md b/README.md index 364cfe3..430ce62 100644 --- a/README.md +++ b/README.md @@ -38,7 +38,7 @@ LISP 1.5 is to all Lisp dialects as Beowulf is to English literature. A work-in-progress towards an implementation of Lisp 1.5 in Clojure. The objective is to build a complete and accurate implementation of Lisp 1.5 as described in the manual, with, in so far as is possible, exactly the -same bahaviour - except as documented below. +same behaviour — except as documented below. ### BUT WHY?!!?! @@ -62,14 +62,11 @@ Working Lisp interpreter, but some key features not yet implemented. ### Project Target -The project target is to be able to run the [Wang algorithm for the propositional calculus](https://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf#page=52) given in chapter 8 of the *Lisp 1.5 Programmer's Manual*. When that runs, the project is as far as I am concerned feature complete. I may keep tinkering with it after that and I'll certainly accept pull requests which are in the spirit of the project (i.e. making Beowulf more usable, and/or implementing parts of Lisp 1.5 which I have not implemented), but this isn't intended to be a new language for doing real work; it's an -educational and archaeological project, not serious engineering. +The project target is to be able to run the [Wang algorithm for the propositional calculus](https://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf#page=52) given in chapter 8 of the *Lisp 1.5 Programmer's Manual*. When that runs, the project is as far as I am concerned feature complete. I may keep tinkering with it after that and I'll certainly accept pull requests which are in the spirit of the project (i.e. making Beowulf more usable, and/or implementing parts of Lisp 1.5 which I have not implemented), but this isn't intended to be a new language for doing real work; it's an educational and archaeological project, not serious engineering. -Some `readline`-like functionality would be really useful, but my attempt to -integrate [JLine](https://github.com/jline/jline3) has not (yet) been successful. +Some `readline`-like functionality would be really useful, but my attempt to integrate [JLine](https://github.com/jline/jline3) has not (yet) been successful. -An in-core structure editor would be an extremely nice thing, and I may well -implement one. +An in-core structure editor would be an extremely nice thing, and I may well implement one. You are of course welcome to fork the project and do whatever you like with it! @@ -110,53 +107,53 @@ now be possible to reimplement them as `FEXPRs` and so the reader macro function | Function | Type | Signature | Implementation | Documentation | |--------------|----------------|------------------|----------------|----------------------| -| NIL | Lisp variable | ? | | see manual pages 22, 69 | -| T | Lisp variable | ? | | see manual pages 22, 69 | -| F | Lisp variable | ? | | see manual pages 22, 69 | -| ADD1 | Host lambda function | ? | | ? | -| AND | Host lambda function | ? | PREDICATE | `T` if and only if none of my `args` evaluate to either `F` or `NIL`, else `F`. In `beowulf.host` principally because I don't yet feel confident to define varargs functions in Lisp. | -| APPEND | Lisp lambda function | ? | | see manual pages 11, 61 | -| APPLY | Host lambda function | ? | | Apply this `function` to these `arguments` in this `environment` and return the result. For bootstrapping, at least, a version of APPLY written in Clojure. All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. See page 13 of the Lisp 1.5 Programmers Manual. | -| ASSOC | Lisp lambda function, Host lambda function | ? | ? | If a is an association list such as the one formed by PAIRLIS in the above example, then assoc will produce the first pair whose first term is x. Thus it is a table searching function. All args are assumed to be `beowulf.cons-cell/ConsCell` objects. See page 12 of the Lisp 1.5 Programmers Manual. **NOTE THAT** this function is overridden by an implementation in Lisp, but is currently still present for bootstrapping. | -| ATOM | Host lambda function | ? | PREDICATE | Returns `T` if and only if the argument `x` is bound to an atom; else `F`. It is not clear to me from the documentation whether `(ATOM 7)` should return `T` or `F`. I'm going to assume `T`. | -| CAR | Host lambda function | ? | | Return the item indicated by the first pointer of a pair. NIL is treated specially: the CAR of NIL is NIL. | -| CAAAAR | Lisp lambda function | ? | ? | ? | -| CAAADR | Lisp lambda function | ? | ? | ? | -| CAAAR | Lisp lambda function | ? | ? | ? | -| CAADAR | Lisp lambda function | ? | ? | ? | -| CAADDR | Lisp lambda function | ? | ? | ? | -| CAADR | Lisp lambda function | ? | ? | ? | -| CAAR | Lisp lambda function | ? | ? | ? | -| CADAAR | Lisp lambda function | ? | ? | ? | -| CADADR | Lisp lambda function | ? | ? | ? | -| CADAR | Lisp lambda function | ? | ? | ? | -| CADDAR | Lisp lambda function | ? | ? | ? | -| CADDDR | Lisp lambda function | ? | ? | ? | -| CADDR | Lisp lambda function | ? | ? | ? | -| CADR | Lisp lambda function | ? | ? | ? | -| CDAAAR | Lisp lambda function | ? | ? | ? | -| CDAADR | Lisp lambda function | ? | ? | ? | -| CDAAR | Lisp lambda function | ? | ? | ? | -| CDADAR | Lisp lambda function | ? | ? | ? | -| CDADDR | Lisp lambda function | ? | ? | ? | -| CDADR | Lisp lambda function | ? | ? | ? | -| CDAR | Lisp lambda function | ? | ? | ? | -| CDDAAR | Lisp lambda function | ? | ? | ? | -| CDDADR | Lisp lambda function | ? | ? | ? | -| CDDAR | Lisp lambda function | ? | ? | ? | -| CDDDAR | Lisp lambda function | ? | ? | ? | -| CDDDDR | Lisp lambda function | ? | ? | ? | -| CDDDR | Lisp lambda function | ? | ? | ? | -| CDDR | Lisp lambda function | ? | ? | ? | -| CDR | Host lambda function | ? | | Return the item indicated by the second pointer of a pair. NIL is treated specially: the CDR of NIL is NIL. | -| CONS | Host lambda function | ? | | Construct a new instance of cons cell with this `car` and `cdr`. | -| CONSP | Host lambda function | ? | ? | Return `T` if object `o` is a cons cell, else `F`. **NOTE THAT** this is an extension function, not available in strct mode. I believe that Lisp 1.5 did not have any mechanism for testing whether an argument was, or was not, a cons cell. | -| COPY | Lisp lambda function | ? | | see manual pages 62 | -| DEFINE | Host lambda function | ? | PSEUDO-FUNCTION | Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten in LISP. The single argument to `DEFINE` should be an association list of symbols to lambda functions. See page 58 of the manual. | -| DIFFERENCE | Host lambda function | ? | | ? | -| DIVIDE | Lisp lambda function | ? | | see manual pages 26, 64 | -| DOC | Host lambda function | ? | ? | Open the page for this `symbol` in the Lisp 1.5 manual, if known, in the default web browser. **NOTE THAT** this is an extension function, not available in strct mode. | -| EFFACE | Lisp lambda function | ? | PSEUDO-FUNCTION | see manual pages 63 | +| NIL | Lisp variable | ? | | The canonical empty list. See manual pages 22, 69s | +| T | Lisp variable | ? | | The canonical true value. See manual pages 22, 69 | +| F | Lisp variable | ? | | The canonical false value. See manual pages 22, 69 | +| ADD1 | Host lambda function | x:number | | Add one to the number `x`. | +| AND | Host lambda function | expr* | PREDICATE | `T` if and only if none of my `args` evaluate to either `F` or `NIL`, else `F`.

In `beowulf.host` principally because I don't yet feel confident to define varargs functions in Lisp. | +| APPEND | Lisp lambda function | ? | | see manual pages 11, 61 | +| APPLY | Host lambda function | ? | | Apply this `function` to these `arguments` in this `environment` and return the result.

For bootstrapping, at least, a version of APPLY written in Clojure.

All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.

See page 13 of the Lisp 1.5 Programmers Manual. | +| ASSOC | Lisp lambda function, Host lambda function | a:list | ? | If a is an association list such as the one formed by PAIRLIS in the above example, then assoc will produce the first pair whose first term is x. Thus it is a table searching function. All args are assumed to be `beowulf.cons-cell/ConsCell` objects. See page 12 of the Lisp 1.5 Programmers Manual.

**NOTE THAT** this function is overridden by an implementation in Lisp, but is currently still present for bootstrapping. | +| ATOM | Host lambda function | x:expr | PREDICATE | Returns `T` if and only if the argument `x` is bound to an atom; else `F`. It is not clear to me from the documentation whether `(ATOM 7)` should return `T` or `F`. I'm going to assume `T`. | +| CAR | Host lambda function | list | | Return the item indicated by the first pointer of a pair. NIL is treated specially: the CAR of NIL is NIL. | +| CAAAAR | Lisp lambda function | list | ? | ? | +| CAAADR | Lisp lambda function | list | ? | ? | +| CAAAR | Lisp lambda function | list | ? | ? | +| CAADAR | Lisp lambda function | list | ? | ? | +| CAADDR | Lisp lambda function | list | ? | ? | +| CAADR | Lisp lambda function | list | ? | ? | +| CAAR | Lisp lambda function | list | ? | ? | +| CADAAR | Lisp lambda function | list | ? | ? | +| CADADR | Lisp lambda function | list | ? | ? | +| CADAR | Lisp lambda function | list | ? | ? | +| CADDAR | Lisp lambda function | list | ? | ? | +| CADDDR | Lisp lambda function | list | ? | ? | +| CADDR | Lisp lambda function | list | ? | ? | +| CADR | Lisp lambda function | list | ? | ? | +| CDAAAR | Lisp lambda function | list | ? | ? | +| CDAADR | Lisp lambda function | list | ? | ? | +| CDAAR | Lisp lambda function | list | ? | ? | +| CDADAR | Lisp lambda function | list | ? | ? | +| CDADDR | Lisp lambda function | list | ? | ? | +| CDADR | Lisp lambda function | list | ? | ? | +| CDAR | Lisp lambda function | list | ? | ? | +| CDDAAR | Lisp lambda function | list | ? | ? | +| CDDADR | Lisp lambda function | list | ? | ? | +| CDDAR | Lisp lambda function | list | ? | ? | +| CDDDAR | Lisp lambda function | list | ? | ? | +| CDDDDR | Lisp lambda function | list | ? | ? | +| CDDDR | Lisp lambda function | list | ? | ? | +| CDDR | Lisp lambda function | list | ? | ? | +| CDR | Host lambda function | list | | Return the item indicated by the second pointer of a pair. NIL is treated specially: the CDR of NIL is NIL. | +| CONS | Host lambda function | expr, expr | | Construct a new instance of cons cell with this `car` and `cdr`. | +| CONSP | Host lambda function | o:expr | ? | Return `T` if object `o` is a cons cell, else `F`.

**NOTE THAT** this is an extension function, not available in strict mode. I believe that Lisp 1.5 did not have any mechanism for testing whether an argument was, or was not, a cons cell. | +| COPY | Lisp lambda function | ? | | see manual pages 62 | +| DEFINE | Host lambda function | ? | PSEUDO-FUNCTION | Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten in LISP. The single argument to `DEFINE` should be an association list of symbols to lambda functions. See page 58 of the manual. | +| DIFFERENCE | Host lambda function | x:number, y:number | | Returns the result of subtracting the number `y` from the number `x` | +| DIVIDE | Lisp lambda function | x:number, y:number | | see manual pages 26, 64 | +| DOC | Host lambda function | ? | ? | Open the page for this `symbol` in the Lisp 1.5 manual, if known, in the default web browser.

**NOTE THAT** this is an extension function, not available in strct mode. | +| EFFACE | Lisp lambda function | ? | PSEUDO-FUNCTION | see manual pages 63 | | ERROR | Host lambda function | ? | PSEUDO-FUNCTION | Throw an error | | EQ | Host lambda function | ? | PREDICATE | Returns `T` if and only if both `x` and `y` are bound to the same atom, else `NIL`. | | EQUAL | Host lambda function | ? | PREDICATE | This is a predicate that is true if its two arguments are identical S-expressions, and false if they are different. (The elementary predicate `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is an example of a conditional expression inside a conditional expression. NOTE: returns `F` on failure, not `NIL` | @@ -164,50 +161,50 @@ now be possible to reimplement them as `FEXPRs` and so the reader macro function | FACTORIAL | Lisp lambda function | ? | ? | ? | | FIXP | Host lambda function | ? | PREDICATE | ? | | GENSYM | Host lambda function | ? | | Generate a unique symbol. | -| GET | Host lambda function | ? | | From the manual: '`get` is somewhat like `prop`; however its value is car of the rest of the list if the `indicator` is found, and NIL otherwise.' It's clear that `GET` is expected to be defined in terms of `PROP`, but we can't implement `PROP` here because we lack `EVAL`; and we can't have `EVAL` here because both it and `APPLY` depends on `GET`. OK, It's worse than that: the statement of the definition of `GET` (and of) `PROP` on page 59 says that the first argument to each must be a list; But the in the definition of `ASSOC` on page 70, when `GET` is called its first argument is always an atom. Since it's `ASSOC` and `EVAL` which I need to make work, I'm going to assume that page 59 is wrong. | +| GET | Host lambda function | ? | | From the manual: '`get` is somewhat like `prop`; however its value is car of the rest of the list if the `indicator` is found, and NIL otherwise.'

It's clear that `GET` is expected to be defined in terms of `PROP`, but we can't implement `PROP` here because we lack `EVAL`; and we can't have `EVAL` here because both it and `APPLY` depends on `GET`.

OK, It's worse than that: the statement of the definition of `GET` (and of) `PROP` on page 59 says that the first argument to each must be a list; But the in the definition of `ASSOC` on page 70, when `GET` is called its first argument is always an atom. Since it's `ASSOC` and `EVAL` which I need to make work, I'm going to assume that page 59 is wrong. | | GREATERP | Host lambda function | ? | PREDICATE | ? | | INTEROP | Host lambda function | ? | ? | ? | | INTERSECTION | Lisp lambda function | ? | ? | ? | -| LENGTH | Lisp lambda function | ? | | see manual pages 62 | +| LENGTH | Lisp lambda function | ? | | see manual pages 62 | | LESSP | Host lambda function | ? | PREDICATE | ? | -| MAPLIST | Lisp lambda function | ? | FUNCTIONAL | see manual pages 20, 21, 63 | -| MEMBER | Lisp lambda function | ? | PREDICATE | see manual pages 11, 62 | -| MINUSP | Lisp lambda function | ? | PREDICATE | see manual pages 26, 64 | -| NOT | Lisp lambda function | ? | PREDICATE | see manual pages 21, 23, 58 | -| NULL | Lisp lambda function | ? | PREDICATE | see manual pages 11, 57 | +| MAPLIST | Lisp lambda function | ? | FUNCTIONAL | see manual pages 20, 21, 63 | +| MEMBER | Lisp lambda function | ? | PREDICATE | see manual pages 11, 62 | +| MINUSP | Lisp lambda function | ? | PREDICATE | see manual pages 26, 64 | +| NOT | Lisp lambda function | ? | PREDICATE | see manual pages 21, 23, 58 | +| NULL | Lisp lambda function | ? | PREDICATE | see manual pages 11, 57 | | NUMBERP | Host lambda function | ? | PREDICATE | ? | -| OBLIST | Host lambda function | ? | | Return a list of the symbols currently bound on the object list. **NOTE THAT** in the Lisp 1.5 manual, footnote at the bottom of page 69, it implies that an argument can be passed but I'm not sure of the semantics of this. | -| ONEP | Lisp lambda function | ? | PREDICATE | see manual pages 26, 64 | -| OR | Host lambda function | ? | PREDICATE | `T` if and only if at least one of my `args` evaluates to something other than either `F` or `NIL`, else `F`. In `beowulf.host` principally because I don't yet feel confident to define varargs functions in Lisp. | -| PAIR | Lisp lambda function | ? | | see manual pages 60 | -| PAIRLIS | Lisp lambda function, Host lambda function | ? | ? | This function gives the list of pairs of corresponding elements of the lists `x` and `y`, and APPENDs this to the list `a`. The resultant list of pairs, which is like a table with two columns, is called an association list. Eessentially, it builds the environment on the stack, implementing shallow binding. All args are assumed to be `beowulf.cons-cell/ConsCell` objects. See page 12 of the Lisp 1.5 Programmers Manual. **NOTE THAT** this function is overridden by an implementation in Lisp, but is currently still present for bootstrapping. | +| OBLIST | Host lambda function | ? | | Return a list of the symbols currently bound on the object list.

**NOTE THAT** in the Lisp 1.5 manual, footnote at the bottom of page 69, it implies that an argument can be passed but I'm not sure of the semantics of this. | +| ONEP | Lisp lambda function | ? | PREDICATE | see manual pages 26, 64 | +| OR | Host lambda function | ? | PREDICATE | `T` if and only if at least one of my `args` evaluates to something other than either `F` or `NIL`, else `F`.

In `beowulf.host` principally because I don't yet feel confident to define varargs functions in Lisp. | +| PAIR | Lisp lambda function | ? | | see manual pages 60 | +| PAIRLIS | Lisp lambda function, Host lambda function | ? | ? | This function gives the list of pairs of corresponding elements of the lists `x` and `y`, and APPENDs this to the list `a`. The resultant list of pairs, which is like a table with two columns, is called an association list. Essentially, it builds the environment on the stack, implementing shallow binding.

All args are assumed to be `beowulf.cons-cell/ConsCell` objects. See page 12 of the Lisp 1.5 Programmers Manual.

**NOTE THAT** this function is overridden by an implementation in Lisp, but is currently still present for bootstrapping. | | PLUS | Host lambda function | ? | | ? | | PRETTY | | ? | ? | ? | -| PRINT | | ? | PSEUDO-FUNCTION | see manual pages 65, 84 | -| PROG | Host nlambda function | ? | | The accursed `PROG` feature. See page 71 of the manual. Lisp 1.5 introduced `PROG`, and most Lisps have been stuck with it ever since. It introduces imperative programming into what should be a pure functional language, and consequently it's going to be a pig to implement. Broadly, `PROG` is a variadic pseudo function called as a `FEXPR` (or possibly an `FSUBR`, although I'm not presently sure that would even work.) The arguments, which are unevaluated, are a list of forms, the first of which is expected to be a list of symbols which will be treated as names of variables within the program, and the rest of which (the 'program body') are either lists or symbols. Lists are treated as Lisp expressions which may be evaulated in turn. Symbols are treated as targets for the `GO` statement. **GO:** A `GO` statement takes the form of `(GO target)`, where `target` should be one of the symbols which occur at top level among that particular invocation of `PROG`s arguments. A `GO` statement may occur at top level in a PROG, or in a clause of a `COND` statement in a `PROG`, but not in a function called from the `PROG` statement. When a `GO` statement is evaluated, execution should transfer immediately to the expression which is the argument list immediately following the symbol which is its target. If the target is not found, an error with the code `A6` should be thrown. **RETURN:** A `RETURN` statement takes the form `(RETURN value)`, where `value` is any value. Following the evaluation of a `RETURN` statement, the `PROG` should immediately exit without executing any further expressions, returning the value. **SET and SETQ:** In addition to the above, if a `SET` or `SETQ` expression is encountered in any expression within the `PROG` body, it should affect not the global object list but instead only the local variables of the program. **COND:** In **strict** mode, when in normal execution, a `COND` statement none of whose clauses match should not return `NIL` but should throw an error with the code `A3`... *except* that inside a `PROG` body, it should not do so. *sigh*. **Flow of control:** Apart from the exceptions specified above, expressions in the program body are evaluated sequentially. If execution reaches the end of the program body, `NIL` is returned. Got all that? Good. | -| PROP | Lisp lambda function | ? | FUNCTIONAL | see manual pages 59 | -| QUOTE | Lisp lambda function | ? | | see manual pages 10, 22, 71 | -| QUOTIENT | Host lambda function | ? | | I'm not certain from the documentation whether Lisp 1.5 `QUOTIENT` returned the integer part of the quotient, or a realnum representing the whole quotient. I am for now implementing the latter. | +| PRINT | | ? | PSEUDO-FUNCTION | see manual pages 65, 84 | +| PROG | Host nlambda function | ? | | The accursed `PROG` feature. See page 71 of the manual.

Lisp 1.5 introduced `PROG`, and most Lisps have been stuck with it ever since. It introduces imperative programming into what should be a pure functional language, and consequently it's going to be a pig to implement. Broadly, `PROG` is a variadic pseudo function called as a `FEXPR` (or possibly an `FSUBR`, although I'm not presently sure that would even work.) The arguments, which are unevaluated, are a list of forms, the first of which is expected to be a list of symbols which will be treated as names of variables within the program, and the rest of which (the 'program body') are either lists or symbols. Lists are treated as Lisp expressions which may be evaulated in turn. Symbols are treated as targets for the `GO` statement. **Flow of control:** Apart from the exceptions specified above, expressions in the program body are evaluated sequentially. If execution reaches the end of the program body, `NIL` is returned.

Got all that? Good. | +| PROP | Lisp lambda function | ? | FUNCTIONAL | see manual pages 59 | +| QUOTE | Lisp lambda function | ? | | see manual pages 10, 22, 71 | +| QUOTIENT | Host lambda function | ? | | I'm not certain from the documentation whether Lisp 1.5 `QUOTIENT` returned the integer part of the quotient, or a realnum representing the whole quotient. I am for now implementing the latter. | | RANGE | Lisp lambda function | ? | ? | ? | | READ | Host lambda function | ? | PSEUDO-FUNCTION | An implementation of a Lisp reader sufficient for bootstrapping; not necessarily the final Lisp reader. `input` should be either a string representation of a LISP expression, or else an input stream. A single form will be read. | | REMAINDER | Host lambda function | ? | | ? | | REPEAT | Lisp lambda function | ? | ? | ? | -| RPLACA | Host lambda function | ? | PSEUDO-FUNCTION | Replace the CAR pointer of this `cell` with this `value`. Dangerous, should really not exist, but does in Lisp 1.5 (and was important for some performance hacks in early Lisps) | -| RPLACD | Host lambda function | ? | PSEUDO-FUNCTION | Replace the CDR pointer of this `cell` with this `value`. Dangerous, should really not exist, but does in Lisp 1.5 (and was important for some performance hacks in early Lisps) | -| SEARCH | Lisp lambda function | ? | FUNCTIONAL | see manual pages 63 | -| SET | Host lambda function | ? | PSEUDO-FUNCTION | Implementation of SET in Clojure. Add to the `oblist` a binding of the value of `var` to the value of `val`. NOTE WELL: this is not SETQ! | +| RPLACA | Host lambda function | ? | PSEUDO-FUNCTION | Replace the `CAR` pointer of this `cell` with this `value`. Dangerous, should really not exist, but does in Lisp 1.5 (and was important for some performance hacks in early Lisps) | +| RPLACD | Host lambda function | ? | PSEUDO-FUNCTION | Replace the `CDR` pointer of this `cell` with this `value`. Dangerous, should really not exist, but does in Lisp 1.5 (and was important for some performance hacks in early Lisps) | +| SEARCH | Lisp lambda function | ? | FUNCTIONAL | see manual pages 63 | +| SET | Host lambda function | ? | PSEUDO-FUNCTION | Implementation of SET in Clojure. Add to the `oblist` a binding of the value of `var` to the value of `val`.

**NOTE WELL**: this is not SETQ! | | SUB1 | Lisp lambda function, Host lambda function | ? | | ? | | SUB2 | Lisp lambda function | ? | ? | ? | -| SUBLIS | Lisp lambda function | ? | | see manual pages 12, 61 | -| SUBST | Lisp lambda function | ? | | see manual pages 11, 61 | -| SYSIN | Host lambda function | ? | ? | Read the contents of the file at this `filename` into the object list. If the file is not a valid Beowulf sysout file, this will probably corrupt the system, you have been warned. File paths will be considered relative to the filepath set when starting Lisp. It is intended that sysout files can be read both from resources within the jar file, and from the file system. If a named file exists in both the file system and the resources, the file system will be preferred. **NOTE THAT** if the provided `filename` does not end with `.lsp` (which, if you're writing it from the Lisp REPL, it won't), the extension `.lsp` will be appended. **NOTE THAT** this is an extension function, not available in strct mode. | -| SYSOUT | Host lambda function | ? | ? | Dump the current content of the object list to file. If no `filepath` is specified, a file name will be constructed of the symbol `Sysout` and the current date. File paths will be considered relative to the filepath set when starting Lisp. **NOTE THAT** this is an extension function, not available in strct mode. | -| TERPRI | | ? | PSEUDO-FUNCTION | see manual pages 65, 84 | +| SUBLIS | Lisp lambda function | ? | | see manual pages 12, 61 | +| SUBST | Lisp lambda function | ? | | see manual pages 11, 61 | +| SYSIN | Host lambda function | ? | ? | Read the contents of the file at this `filename` into the object list. If the file is not a valid Beowulf sysout file, this will probably corrupt the system, you have been warned. File paths will be considered relative to the filepath set when starting Lisp. It is intended that sysout files can be read both from resources within the jar file, and from the file system. If a named file exists in both the file system and the resources, the file system will be preferred.

**NOTE THAT** if the provided `filename` does not end with `.lsp` (which, if you're writing it from the Lisp REPL, it won't), the extension `.lsp` will be appended.

**NOTE THAT** this is an extension function, not available in strct mode. | +| SYSOUT | Host lambda function | ? | ? | Dump the current content of the object list to file. If no `filepath` is specified, a file name will be constructed of the symbol `Sysout` and the current date. File paths will be considered relative to the filepath set when starting Lisp.

**NOTE THAT** this is an extension function, not available in strict mode. | +| TERPRI | | ? | PSEUDO-FUNCTION | see manual pages 65, 84 | | TIMES | Host lambda function | ? | | ? | | TRACE | Host lambda function | ? | PSEUDO-FUNCTION | Add this `s` to the set of symbols currently being traced. If `s` is not a symbol or sequence of symbols, does nothing. | | UNION | Lisp lambda function | ? | ? | ? | -| UNTRACE | Host lambda function | ? | PSEUDO-FUNCTION | Remove this `s` from the set of symbols currently being traced. If `s` is not a symbol or sequence of symbols, does nothing. | -| ZEROP | Lisp lambda function | ? | PREDICATE | see manual pages 26, 64 | +| UNTRACE | Host lambda function | ? | PSEUDO-FUNCTION | Remove this `s` from the set of symbols currently being traced. If `s` is not a symbol or sequence of symbols, does nothing. | +| ZEROP | Lisp lambda function | ? | PREDICATE | see manual pages 26, 64 | Functions described as 'Lisp function' above are defined in the default sysout file, `resources/lisp1.5.lsp`, which will be loaded by default unless @@ -219,8 +216,7 @@ over the Clojure implementations. ### Architectural plan -Not everything documented in this section is yet built. It indicates the -direction of travel and intended destination, not the current state. +Not everything documented in this section is yet built. It indicates the direction of travel and intended destination, not the current state. #### resources/lisp1.5.lsp diff --git a/docs/cloverage/beowulf/bootstrap.clj.html b/docs/cloverage/beowulf/bootstrap.clj.html index 20afabb..c45387d 100644 --- a/docs/cloverage/beowulf/bootstrap.clj.html +++ b/docs/cloverage/beowulf/bootstrap.clj.html @@ -38,1213 +38,1237 @@ 011    objects."
- 012    (:require [clojure.string :as s] + 012    (:require [beowulf.cons-cell :refer [F make-beowulf-list make-cons-cell
- 013              [clojure.tools.trace :refer :all] + 013                                         pretty-print T]]
- 014              [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]])) + 014              [beowulf.host :refer [ASSOC ATOM CAAR CADAR CADDR CADR CAR CDR GET +
+ + 015                                    LIST NUMBERP PAIRLIS traced?]] +
+ + 016              [beowulf.oblist :refer [*options* NIL oblist]]) +
+ + 017    (:import [beowulf.cons_cell ConsCell] +
+ + 018             [clojure.lang Symbol]))
- 015   + 019  
- 016  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 020  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 017  ;;; + 021  ;;;
- 018  ;;; This file is essentially Lisp as defined in Chapter 1 (pages 1-14) of the -
- - 019  ;;; Lisp 1.5 Programmer's Manual; that is to say, a very simple Lisp language, -
- - 020  ;;; which should, I believe, be sufficient in conjunction with the functions -
- - 021  ;;; provided by `beowulf.host`, be sufficient to bootstrap the full Lisp 1.5 -
- - 022  ;;; interpreter. + 022  ;;; Copyright (C) 2022-2023 Simon Brooke
023  ;;;
- 024  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 024  ;;; This program is free software; you can redistribute it and/or +
+ + 025  ;;; modify it under the terms of the GNU General Public License +
+ + 026  ;;; as published by the Free Software Foundation; either version 2 +
+ + 027  ;;; of the License, or (at your option) any later version. +
+ + 028  ;;;  +
+ + 029  ;;; This program is distributed in the hope that it will be useful, +
+ + 030  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 031  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 032  ;;; GNU General Public License for more details. +
+ + 033  ;;;  +
+ + 034  ;;; You should have received a copy of the GNU General Public License +
+ + 035  ;;; along with this program; if not, write to the Free Software +
+ + 036  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 037  ;;; +
+ + 038  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 025   -
- - 026  (declare EVAL) -
- - 027   -
- - 028  (def oblist -
- - 029    "The default environment." -
- - 030    (atom NIL)) -
- - 031   -
- - 032  (def ^:dynamic *options* -
- - 033    "Command line options from invocation." -
- - 034    {}) -
- - 035   -
- - 036  (defmacro NULL -
- - 037    "Returns `T` if and only if the argument `x` is bound to `NIL`; else `F`." -
- - 038    [x] -
- - 039    `(if (= ~x NIL) T F)) -
- - 040   -
- - 041  (defmacro ATOM -
- - 042    "Returns `T` if and only is the argument `x` is bound to and atom; else `F`. -
- - 043    It is not clear to me from the documentation whether `(ATOM 7)` should return -
- - 044    `T` or `F`. I'm going to assume `T`." -
- - 045    [x] -
- - 046    `(if (or (symbol? ~x) (number? ~x)) T F)) -
- - 047   -
- - 048  (defmacro ATOM? -
- - 049    "The convention of returning `F` from predicates, rather than `NIL`, is going -
- - 050    to tie me in knots. This is a variant of `ATOM` which returns `NIL` -
- - 051    on failure." -
- - 052    [x] -
- - 053    `(if (or (symbol? ~x) (number? ~x)) T NIL)) -
- - 054   -
- - 055  (defn CAR -
- - 056    "Return the item indicated by the first pointer of a pair. NIL is treated -
- - 057    specially: the CAR of NIL is NIL." -
- - 058    [x] -
- - 059    (cond -
- - 060      (= x NIL) NIL -
- - 061      (instance? beowulf.cons_cell.ConsCell x) (.CAR x) -
- - 062      :else -
- - 063      (throw -
- - 064        (Exception. -
- - 065          (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")"))))) -
- - 066   -
- - 067  (defn CDR -
- - 068    "Return the item indicated by the second pointer of a pair. NIL is treated -
- - 069    specially: the CDR of NIL is NIL." -
- - 070    [x] -
- - 071    (cond -
- - 072      (= x NIL) NIL -
- - 073      (instance? beowulf.cons_cell.ConsCell x) (.CDR x) -
- - 074      :else -
- - 075      (throw -
- - 076        (Exception. -
- - 077          (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")"))))) -
- - 078   -
- - 079  (defn uaf -
- - 080    "Universal access function; `l` is expected to be an arbitrary list, `path` -
- - 081    a (clojure) list of the characters `a` and `d`. Intended to make declaring -
- - 082    all those fiddly `#'c[ad]+r'` functions a bit easier" -
- - 083    [l path] -
- - 084    (cond -
- - 085      (= l NIL) NIL + 039  
- 086      (empty? path) l -
- - 087      :else (case (last path) -
- - 088              \a (uaf (CAR l) (butlast path)) -
- - 089              \d (uaf (CDR l) (butlast path))))) + 040  (declare APPLY EVAL prog-eval)
- 090   + 041  
- - 091  (defn CAAR [x] (uaf x (seq "aa"))) -
- - 092  (defn CADR [x] (uaf x (seq "ad"))) -
- - 093  (defn CDDR [x] (uaf x (seq "dd"))) -
- - 094  (defn CDAR [x] (uaf x (seq "da"))) + + 042  ;;;; The PROGram feature ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 095   -
- - 096  (defn CAAAR [x] (uaf x (seq "aaa"))) -
- - 097  (defn CAADR [x] (uaf x (seq "aad"))) -
- - 098  (defn CADAR [x] (uaf x (seq "ada"))) -
- - 099  (defn CADDR [x] (uaf x (seq "add"))) -
- - 100  (defn CDDAR [x] (uaf x (seq "dda"))) -
- - 101  (defn CDDDR [x] (uaf x (seq "ddd"))) -
- - 102  (defn CDAAR [x] (uaf x (seq "daa"))) -
- - 103  (defn CDADR [x] (uaf x (seq "dad"))) -
- - 104   -
- - 105  (defn CAAAAR [x] (uaf x (seq "aaaa"))) -
- - 106  (defn CAADAR [x] (uaf x (seq "aada"))) -
- - 107  (defn CADAAR [x] (uaf x (seq "adaa"))) -
- - 108  (defn CADDAR [x] (uaf x (seq "adda"))) -
- - 109  (defn CDDAAR [x] (uaf x (seq "ddaa"))) -
- - 110  (defn CDDDAR [x] (uaf x (seq "ddda"))) -
- - 111  (defn CDAAAR [x] (uaf x (seq "daaa"))) -
- - 112  (defn CDADAR [x] (uaf x (seq "dada"))) -
- - 113  (defn CAAADR [x] (uaf x (seq "aaad"))) -
- - 114  (defn CAADDR [x] (uaf x (seq "aadd"))) -
- - 115  (defn CADADR [x] (uaf x (seq "adad"))) -
- - 116  (defn CADDDR [x] (uaf x (seq "addd"))) -
- - 117  (defn CDDADR [x] (uaf x (seq "ddad"))) -
- - 118  (defn CDDDDR [x] (uaf x (seq "dddd"))) -
- - 119  (defn CDAADR [x] (uaf x (seq "daad"))) -
- - 120  (defn CDADDR [x] (uaf x (seq "dadd"))) -
- - 121   + 043  
- 122  (defn EQ + 044  (def find-target
- - 123    "Returns `T` if and only if both `x` and `y` are bound to the same atom, -
- - 124    else `F`." -
- - 125    [x y] -
- - 126    (if (and (= (ATOM x) T) (= x y)) T F)) -
- - 127   + + 045    (memoize
- 128  (defn EQUAL + 046     (fn [target body]
- - 129    "This is a predicate that is true if its two arguments are identical -
- - 130    S-expressions, and false if they are different. (The elementary predicate -
- - 131    `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is -
- - 132    an example of a conditional expression inside a conditional expression. -
- - 133   -
- - 134    NOTE: returns `F` on failure, not `NIL`" -
- - 135    [x y] + + 047       (loop [body' body]
- 136    (cond + 048         (cond
- - 137      (= (ATOM x) T) (EQ x y) + + 049           (= body' NIL) (throw (ex-info (str "Mislar GO miercels: `" target "`")
- - 138      (= (EQUAL (CAR x) (CAR y)) T) (EQUAL (CDR x) (CDR y)) -
- - 139      :else F)) -
- - 140   -
- - 141  (defn SUBST + + 050                                         {:phase :lisp
- 142    "This function gives the result of substituting the S-expression `x` for + 051                                          :function 'PROG
- 143    all occurrences of the atomic symbol `y` in the S-expression `z`." + 052                                          :type :lisp
- 144    [x y z] -
- - 145    (cond -
- - 146      (= (EQUAL y z) T) x -
- - 147      (= (ATOM? z) T) z ;; NIL is a symbol -
- - 148      :else -
- - 149      (make-cons-cell (SUBST x y (CAR z)) (SUBST x y (CDR z))))) -
- - 150   -
- - 151  (defn APPEND -
- - 152    "Append the the elements of `y` to the elements of `x`. -
- - 153   -
- - 154    All args are assumed to be `beowulf.cons-cell/ConsCell` objects. -
- - 155    See page 11 of the Lisp 1.5 Programmers Manual." -
- - 156    [x y] -
- - 157    (cond -
- - 158      (= x NIL) y -
- - 159      :else -
- - 160      (make-cons-cell (CAR x) (APPEND (CDR x) y)))) -
- - 161   -
- - 162   -
- - 163  (defn MEMBER -
- - 164    "This predicate is true if the S-expression `x` occurs among the elements -
- - 165    of the list `y`. -
- - 166   -
- - 167    All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. -
- - 168    See page 11 of the Lisp 1.5 Programmers Manual." -
- - 169    [x y] -
- - 170    (cond -
- - 171      (= y NIL) F ;; NOTE: returns F on falsity, not NIL -
- - 172      (= (EQUAL x (CAR y)) T) T -
- - 173      :else (MEMBER x (CDR y)))) -
- - 174   -
- - 175  (defn PAIRLIS -
- - 176    "This function gives the list of pairs of corresponding elements of the -
- - 177    lists `x` and `y`, and APPENDs this to the list `a`. The resultant list -
- - 178    of pairs, which is like a table with two columns, is called an -
- - 179    association list. -
- - 180   -
- - 181    Eessentially, it builds the environment on the stack, implementing shallow -
- - 182    binding. -
- - 183   -
- - 184    All args are assumed to be `beowulf.cons-cell/ConsCell` objects. -
- - 185    See page 12 of the Lisp 1.5 Programmers Manual." -
- - 186    [x y a] -
- - 187    (cond -
- - 188      ;; the original tests only x; testing y as well will be a little more -
- - 189      ;; robust if `x` and `y` are not the same length. -
- - 190      (or (= NIL x) (= NIL y)) a -
- - 191      :else (make-cons-cell -
- - 192              (make-cons-cell (CAR x) (CAR y)) -
- - 193              (PAIRLIS (CDR x) (CDR y) a)))) -
- - 194   -
- - 195  (defn ASSOC -
- - 196    "If a is an association list such as the one formed by PAIRLIS in the above -
- - 197    example, then assoc will produce the first pair whose first term is x. Thus -
- - 198    it is a table searching function. -
- - 199   -
- - 200    All args are assumed to be `beowulf.cons-cell/ConsCell` objects. -
- - 201    See page 12 of the Lisp 1.5 Programmers Manual." -
- - 202    [x a] -
- - 203    (cond -
- - 204      (= NIL a) NIL ;; this clause is not present in the original but is added for -
- - 205      ;; robustness. -
- - 206      (= (EQUAL (CAAR a) x) T) (CAR a) -
- - 207      :else -
- - 208      (ASSOC x (CDR a)))) -
- - 209   -
- - 210  (defn- SUB2 -
- - 211    "Internal to `SUBLIS`, q.v., which SUBSTitutes into a list from a store. -
- - 212    ? I think this is doing variable binding in the stack frame?" -
- - 213    [a z] -
- - 214    (cond -
- - 215      (= NIL a) z -
- - 216      (= (CAAR a) z) (CDAR a) ;; TODO: this looks definitely wrong -
- - 217      :else -
- - 218      (SUB2 (CDR a) z))) -
- - 219   -
- - 220  (defn SUBLIS -
- - 221    "Here `a` is assumed to be an association list of the form -
- - 222    `((ul . vl)...(un . vn))`, where the `u`s are atomic, and `y` is any -
- - 223    S-expression. What `SUBLIS` does, is to treat the `u`s as variables when -
- - 224    they occur in `y`, and to SUBSTitute the corresponding `v`s from the pair -
- - 225    list. -
- - 226   -
- - 227    My interpretation is that this is variable binding in the stack frame. -
- - 228   -
- - 229    All args are assumed to be `beowulf.cons-cell/ConsCell` objects. -
- - 230    See page 12 of the Lisp 1.5 Programmers Manual." -
- - 231    [a y] -
- - 232    (cond -
- - 233      (= (ATOM? y) T) (SUB2 a y) -
- - 234      :else -
- - 235      (make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y))))) -
- - 236   -
- - 237  (defn interop-interpret-q-name -
- - 238    "For interoperation with Clojure, it will often be necessary to pass -
- - 239    qualified names that are not representable in Lisp 1.5. This function -
- - 240    takes a sequence in the form `(PART PART PART... NAME)` and returns -
- - 241    a symbol in the form `PART.PART.PART/NAME`. This symbol will then be -
- - 242    tried in both that form and lower-cased. Names with hyphens or -
- - 243    underscores cannot be represented with this scheme." -
- - 244    [l] + 053                                          :code :A6
- 245    (if -
- - 246      (seq? l) -
- - 247      (symbol -
- - 248        (s/reverse -
- - 249          (s/replace-first -
- - 250            (s/reverse -
- - 251              (s/join "." (map str l))) -
- - 252            "." -
- - 253            "/"))) -
- - 254      l)) -
- - 255   -
- - 256  (deftrace INTEROP -
- - 257    "Clojure (or other host environment) interoperation API. `fn-symbol` is expected -
- - 258    to be either -
- - 259   -
- - 260    1. a symbol bound in the host environment to a function; or -
- - 261    2. a sequence (list) of symbols forming a qualified path name bound to a -
- - 262       function. -
- - 263   -
- - 264    Lower case characters cannot normally be represented in Lisp 1.5, so both the -
- - 265    upper case and lower case variants of `fn-symbol` will be tried. If the -
- - 266    function you're looking for has a mixed case name, that is not currently -
- - 267    accessible. -
- - 268   -
- - 269    `args` is expected to be a Lisp 1.5 list of arguments to be passed to that -
- - 270    function. Return value must be something acceptable to Lisp 1.5, so either -
- - 271    a symbol, a number, or a Lisp 1.5 list. -
- - 272   -
- - 273    If `fn-symbol` is not found (even when cast to lower case), or is not a function, -
- - 274    or the value returned cannot be represented in Lisp 1.5, an exception is thrown -
- - 275    with `:cause` bound to `:interop` and `:detail` set to a value representing the -
- - 276    actual problem." -
- - 277    [fn-symbol args] -
- - 278    (let -
- - 279      [q-name (if -
- - 280                (seq? fn-symbol) -
- - 281                (interop-interpret-q-name fn-symbol) -
- - 282                fn-symbol) -
- - 283       l-name (symbol (s/lower-case q-name)) -
- - 284       f (cond -
- - 285              (try -
- - 286                (fn? (eval l-name)) -
- - 287                (catch java.lang.ClassNotFoundException e nil)) (eval l-name) -
- - 288              (try -
- - 289                (fn? (eval q-name)) -
- - 290                (catch java.lang.ClassNotFoundException e nil)) (eval q-name) -
- - 291               :else (throw -
- - 292                       (ex-info -
- - 293                         (str "INTEROP: unknown function `" fn-symbol "`") -
- - 294                         {:cause :interop -
- - 295                          :detail :not-found -
- - 296                           :name fn-symbol -
- - 297                           :also-tried l-name}))) -
- - 298        result (eval (cons f args))] -
- - 299      (cond -
- - 300        (instance? beowulf.cons_cell.ConsCell result) result -
- - 301        (seq? result) (make-beowulf-list result) -
- - 302        (symbol? result) result -
- - 303        (string? result) (symbol result) -
- - 304        (number? result) result -
- - 305        :else (throw -
- - 306                (ex-info -
- - 307                  (str "INTEROP: Cannot return `" result "` to Lisp 1.5.") -
- - 308                  {:cause :interop -
- - 309                   :detail :not-representable -
- - 310                   :result result}))))) -
- - 311   -
- - 312  (defn APPLY -
- - 313    "For bootstrapping, at least, a version of APPLY written in Clojure. -
- - 314    All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. -
- - 315    See page 13 of the Lisp 1.5 Programmers Manual." -
- - 316    [function args environment] -
- - 317    (cond -
- - 318      (= -
- - 319        (ATOM? function) -
- - 320        T)(cond -
- - 321             ;; TODO: doesn't check whether `function` is bound in the environment; -
- - 322             ;; we'll need that before we can bootstrap. -
- - 323             (= function 'CAR) (CAAR args) -
- - 324             (= function 'CDR) (CDAR args) -
- - 325             (= function 'CONS) (make-cons-cell (CAR args) (CADR args)) -
- - 326             (= function 'ATOM) (if (ATOM? (CAR args)) T NIL) -
- - 327             (= function 'EQ) (if (= (CAR args) (CADR args)) T NIL) -
- - 328             :else -
- - 329             (APPLY -
- - 330               (EVAL function environment) -
- - 331               args -
- - 332               environment)) -
- - 333      (= (first function) 'LAMBDA) (EVAL -
- - 334                                     (CADDR function) -
- - 335                                     (PAIRLIS (CADR function) args environment)) -
- - 336      (= (first function) 'LABEL) (APPLY -
- - 337                                    (CADDR function) -
- - 338                                    args -
- - 339                                    (make-cons-cell -
- - 340                                      (make-cons-cell -
- - 341                                        (CADR function) -
- - 342                                        (CADDR function)) -
- - 343                                      environment)))) -
- - 344   -
- - 345  (defn- EVCON -
- - 346    "Inner guts of primitive COND. All args are assumed to be -
- - 347    `beowulf.cons-cell/ConsCell` objects. -
- - 348    See page 13 of the Lisp 1.5 Programmers Manual." -
- - 349    [clauses env] -
- - 350    (if -
- - 351      (not= (EVAL (CAAR clauses) env) NIL) -
- - 352      (EVAL (CADAR clauses) env) -
- - 353      (EVCON (CDR clauses) env))) -
- - 354   -
- - 355  (defn- EVLIS -
- - 356    "Map `EVAL` across this list of `args` in the context of this -
- - 357    `env`ironment.All args are assumed to be `beowulf.cons-cell/ConsCell` objects. -
- - 358    See page 13 of the Lisp 1.5 Programmers Manual." -
- - 359    [args env] -
- - 360    (cond -
- - 361      (= NIL args) NIL -
- - 362      :else -
- - 363      (make-cons-cell -
- - 364        (EVAL (CAR args) env) -
- - 365        (EVLIS (CDR args) env)))) -
- - 366   -
- - 367  (deftrace traced-eval -
- - 368    "Essentially, identical to EVAL except traced." -
- - 369    [expr env] -
- - 370    (cond -
- - 371      (= -
- - 372        (ATOM? expr) T) -
- - 373      (CDR (ASSOC expr env)) -
- - 374      (= -
- - 375        (ATOM? (CAR expr)) + 054                                          :target target}))
- 376        T)(cond -
- - 377             (= (CAR expr) 'QUOTE) (CADR expr) -
- - 378             (= (CAR expr) 'COND) (EVCON (CDR expr) env) -
- - 379             :else (APPLY -
- - 380                     (CAR expr) -
- - 381                     (EVLIS (CDR expr) env) + 055           (= (.getCar body') target) body'
- 382                     env)) -
- - 383      :else (APPLY -
- - 384              (CAR expr) -
- - 385              (EVLIS (CDR expr) env) -
- - 386              env))) + 056           :else (recur (.getCdr body')))))))
- 387   + 057  
- 388  (defn EVAL + 058  (defn- prog-cond
- 389    "For bootstrapping, at least, a version of EVAL written in Clojure. + 059    "Like `EVCON`, q.v. except using `prog-eval` instead of `EVAL` and not
- 390    All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. + 060     throwing an error if no clause matches."
- 391    See page 13 of the Lisp 1.5 Programmers Manual." + 061    [clauses vars env depth] +
+ + 062    (loop [clauses' clauses] +
+ + 063      (if-not (= clauses' NIL) +
+ + 064        (let [test (prog-eval (CAAR clauses') vars env depth)] +
+ + 065          (if (not (#{NIL F} test)) +
+ + 066            (prog-eval (CADAR clauses') vars env depth) +
+ + 067            (recur (.getCdr clauses')))) +
+ + 068        NIL))) +
+ + 069   +
+ + 070  (defn- merge-vars [vars env] +
+ + 071    (reduce +
+ + 072     #(make-cons-cell +
+ + 073       (make-cons-cell %2 (@vars %2)) +
+ + 074       env) +
+ + 075     env +
+ + 076     (keys @vars))) +
+ + 077   +
+ + 078  (defn prog-eval
- 392    [expr env] + 079    "Like `EVAL`, q.v., except handling symbols, and expressions starting +
+ + 080     `GO`, `RETURN`, `SET` and `SETQ` specially." +
+ + 081    [expr vars env depth]
- 393    (cond -
- - 394      (true? (:trace *options*)) + 082    (cond
- 395      (traced-eval expr env) + 083      (number? expr) expr
- - 396      (= + + 084      (symbol? expr) (@vars expr)
- - 397        (ATOM? expr) T) -
- - 398      (CDR (ASSOC expr env)) -
- - 399      (= -
- - 400        (ATOM? (CAR expr)) -
- - 401        T)(cond -
- - 402             (= (CAR expr) 'QUOTE) (CADR expr) -
- - 403             (= (CAR expr) 'COND) (EVCON (CDR expr) env) -
- - 404             :else (APPLY + + 085      (instance? ConsCell expr) (case (.getCar expr)
- 405                     (CAR expr) + 086                                  COND (prog-cond (.getCdr expr)
- - 406                     (EVLIS (CDR expr) env) + + 087                                                  vars env depth) +
+ + 088                                  GO (make-cons-cell +
+ + 089                                      '*PROGGO* (.getCar (.getCdr expr))) +
+ + 090                                  RETURN (make-cons-cell +
+ + 091                                          '*PROGRETURN* +
+ + 092                                          (prog-eval (.getCar (.getCdr expr)) +
+ + 093                                                     vars env depth)) +
+ + 094                                  SET (let [v (CADDR expr)] +
+ + 095                                        (swap! vars
- 407                     env)) + 096                                               assoc
- - 408      :else (APPLY + + 097                                               (prog-eval (CADR expr) +
+ + 098                                                          vars env depth) +
+ + 099                                               (prog-eval (CADDR expr) +
+ + 100                                                          vars env depth)) +
+ + 101                                        v) +
+ + 102                                  SETQ (let [v (CADDR expr)]
- 409              (CAR expr) -
- - 410              (EVLIS (CDR expr) env) + 103                                         (swap! vars
- 411              env))) + 104                                                assoc +
+ + 105                                                (CADR expr) +
+ + 106                                                (prog-eval v +
+ + 107                                                           vars env depth)) +
+ + 108                                         v) +
+ + 109                                   ;; else +
+ + 110                                  (beowulf.bootstrap/EVAL expr +
+ + 111                                                          (merge-vars vars env) +
+ + 112                                                          depth))))
- 412   + 113   +
+ + 114  (defn PROG +
+ + 115    "The accursed `PROG` feature. See page 71 of the manual. +
+ + 116      +
+ + 117     Lisp 1.5 introduced `PROG`, and most Lisps have been stuck with it ever  +
+ + 118     since. It introduces imperative programming into what should be a pure  +
+ + 119     functional language, and consequently it's going to be a pig to implement. +
+ + 120      +
+ + 121     Broadly, `PROG` is a variadic pseudo function called as a `FEXPR` (or  +
+ + 122     possibly an `FSUBR`, although I'm not presently sure that would even work.)
- 413   + 123   +
+ + 124     The arguments, which are unevaluated, are a list of forms, the first of  +
+ + 125     which is expected to be a list of symbols which will be treated as names  +
+ + 126     of variables within the program, and the rest of which (the 'program body') +
+ + 127     are either lists or symbols. Lists are treated as Lisp expressions which +
+ + 128     may be evaulated in turn. Symbols are treated as targets for the `GO`  +
+ + 129     statement.  +
+ + 130         +
+ + 131     **GO:**  +
+ + 132     A `GO` statement takes the form of `(GO target)`, where  +
+ + 133     `target` should be one of the symbols which occur at top level among that +
+ + 134     particular invocation of `PROG`s arguments. A `GO` statement may occur at  +
+ + 135     top level in a PROG, or in a clause of a `COND` statement in a `PROG`, but +
+ + 136     not in a function called from the `PROG` statement. When a `GO` statement +
+ + 137     is evaluated, execution should transfer immediately to the expression which +
+ + 138     is the argument list immediately following the symbol which is its target.
- 414   + 139   +
+ + 140     If the target is not found, an error with the code `A6` should be thrown. +
+ + 141   +
+ + 142     **RETURN:**  +
+ + 143     A `RETURN` statement takes the form `(RETURN value)`, where  +
+ + 144     `value` is any value. Following the evaluation of a `RETURN` statement,  +
+ + 145     the `PROG` should immediately exit without executing any further  +
+ + 146     expressions, returning the  value. +
+ + 147   +
+ + 148     **SET and SETQ:** +
+ + 149     In addition to the above, if a `SET` or `SETQ` expression is encountered +
+ + 150     in any expression within the `PROG` body, it should affect not the global +
+ + 151     object list but instead only the local variables of the program. +
+ + 152   +
+ + 153     **COND:** +
+ + 154     In **strict** mode, when in normal execution, a `COND` statement none of  +
+ + 155     whose clauses match should not return `NIL` but should throw an error with +
+ + 156     the code `A3`... *except* that inside a `PROG` body, it should not do so. +
+ + 157     *sigh*. +
+ + 158   +
+ + 159     **Flow of control:** +
+ + 160     Apart from the exceptions specified above, expressions in the program body +
+ + 161     are evaluated sequentially. If execution reaches the end of the program  +
+ + 162     body, `NIL` is returned. +
+ + 163   +
+ + 164     Got all that? +
+ + 165   +
+ + 166     Good." +
+ + 167    [program env depth] +
+ + 168    (let [trace (traced? 'PROG) +
+ + 169          vars (atom (reduce merge (map #(assoc {} % NIL) (.getCar program)))) +
+ + 170          body (.getCdr program) +
+ + 171          targets (set (filter symbol? body))] +
+ + 172      (when trace (do +
+ + 173                    (println "Program:") +
+ + 174                    (pretty-print program))) ;; for debugging +
+ + 175      (loop [cursor body] +
+ + 176        (let [step (.getCar cursor)] +
+ + 177          (when trace (do (println "Executing step: " step) +
+ + 178                          (println "  with vars: " @vars))) +
+ + 179          (cond (= cursor NIL) NIL +
+ + 180                (symbol? step) (recur (.getCdr cursor)) +
+ + 181                :else (let [v (prog-eval (.getCar cursor) vars env depth)] +
+ + 182                        (when trace (println "  --> " v)) +
+ + 183                        (if (instance? ConsCell v) +
+ + 184                          (case (.getCar v) +
+ + 185                            *PROGGO* (let [target (.getCdr v)] +
+ + 186                                       (if (targets target) +
+ + 187                                         (recur (find-target target body)) +
+ + 188                                         (throw (ex-info (str "Uncynlic GO miercels `" +
+ + 189                                                              target "`") +
+ + 190                                                         {:phase :lisp +
+ + 191                                                          :function 'PROG +
+ + 192                                                          :args program +
+ + 193                                                          :type :lisp +
+ + 194                                                          :code :A6 +
+ + 195                                                          :target target +
+ + 196                                                          :targets targets})))) +
+ + 197                            *PROGRETURN* (.getCdr v) +
+ + 198                          ;; else +
+ + 199                            (recur (.getCdr cursor))) +
+ + 200                          (recur (.getCdr cursor))))))))) +
+ + 201   +
+ + 202  ;;;; Tracing execution ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 203   +
+ + 204  (defn- trace-call +
+ + 205    "Show a trace of a call to the function named by this `function-symbol`  +
+ + 206    with these `args` at this depth." +
+ + 207    [function-symbol args depth] +
+ + 208    (when (traced? function-symbol) +
+ + 209      (let [indent (apply str (repeat depth "-"))] +
+ + 210        (println (str indent "> " function-symbol " " args))))) +
+ + 211   +
+ + 212  (defn- trace-response +
+ + 213    "Show a trace of this `response` from the function named by this +
+ + 214     `function-symbol` at this depth." +
+ + 215    [function-symbol response depth] +
+ + 216    (when (traced? function-symbol) +
+ + 217      (let [indent (apply str (repeat depth "-"))] +
+ + 218        (println (str "<" indent " " function-symbol " " response)))) +
+ + 219    response) +
+ + 220   +
+ + 221  (defn- value +
+ + 222    "Seek a value for this symbol `s` by checking each of these indicators in +
+ + 223     turn." +
+ + 224    ([s] +
+ + 225     (value s (list 'APVAL 'EXPR 'FEXPR 'SUBR 'FSUBR))) +
+ + 226    ([s indicators] +
+ + 227     (when (symbol? s) +
+ + 228       (first (remove #(= % NIL) (map #(GET s %) +
+ + 229                                      indicators)))))) +
+ + 230   +
+ + 231  ;;;; APPLY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 232   +
+ + 233  (defn try-resolve-subroutine +
+ + 234    "Attempt to resolve this `subr` with these `args`." +
+ + 235    [subr args] +
+ + 236    (when (and subr (not= subr NIL)) +
+ + 237      (try @(resolve subr) +
+ + 238           (catch Throwable any +
+ + 239             (throw (ex-info "þegnung (SUBR) ne āfand" +
+ + 240                             {:phase :apply +
+ + 241                              :function subr +
+ + 242                              :args args +
+ + 243                              :type :beowulf} +
+ + 244                             any)))))) +
+ + 245   +
+ + 246  (defn- apply-symbolic +
+ + 247    "Apply this `funtion-symbol` to these `args` in this `environment` and  +
+ + 248     return the result." +
+ + 249    [^Symbol function-symbol args ^ConsCell environment depth] +
+ + 250    (trace-call function-symbol args depth) +
+ + 251    (let [lisp-fn (value function-symbol '(EXPR FEXPR)) +
+ + 252          args' (cond (= NIL args) args +
+ + 253                      (empty? args) NIL +
+ + 254                      (instance? ConsCell args) args +
+ + 255                      :else (make-beowulf-list args)) +
+ + 256          subr (value function-symbol '(SUBR FSUBR)) +
+ + 257          host-fn (try-resolve-subroutine subr args') +
+ + 258          result (cond (and lisp-fn +
+ + 259                            (not= lisp-fn NIL)) (APPLY lisp-fn args' environment depth) +
+ + 260                       host-fn (try +
+ + 261                                 (apply host-fn (when (instance? ConsCell args') args')) +
+ + 262                                 (catch Exception any +
+ + 263                                   (throw (ex-info (str "Uncynlic þegnung: " +
+ + 264                                                        (.getMessage any)) +
+ + 265                                                   {:phase :apply +
+ + 266                                                    :function function-symbol +
+ + 267                                                    :args args +
+ + 268                                                    :type :beowulf} +
+ + 269                                                   any)))) +
+ + 270                       :else (ex-info "þegnung ne āfand" +
+ + 271                                      {:phase :apply +
+ + 272                                       :function function-symbol +
+ + 273                                       :args args +
+ + 274                                       :type :beowulf}))] +
+ + 275      (trace-response function-symbol result depth) +
+ + 276      result)) +
+ + 277   +
+ + 278  (defn APPLY +
+ + 279    "Apply this `function` to these `arguments` in this `environment` and return +
+ + 280     the result. +
+ + 281      +
+ + 282     For bootstrapping, at least, a version of APPLY written in Clojure. +
+ + 283     All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. +
+ + 284     See page 13 of the Lisp 1.5 Programmers Manual." +
+ + 285    [function args environment depth] +
+ + 286    (trace-call 'APPLY (list function args environment) depth) +
+ + 287    (let [result (cond +
+ + 288                   (= NIL function) (if (:strict *options*) +
+ + 289                                      NIL +
+ + 290                                      (throw (ex-info "NIL sí ne þegnung" +
+ + 291                                                      {:phase :apply +
+ + 292                                                       :function "NIL" +
+ + 293                                                       :args args +
+ + 294                                                       :type :beowulf}))) +
+ + 295                   (= (ATOM function) T) (apply-symbolic function args environment (inc depth)) +
+ + 296                   :else (case (first function) +
+ + 297                           LABEL (APPLY +
+ + 298                                  (CADDR function) +
+ + 299                                  args +
+ + 300                                  (make-cons-cell +
+ + 301                                   (make-cons-cell +
+ + 302                                    (CADR function) +
+ + 303                                    (CADDR function)) +
+ + 304                                   environment) +
+ + 305                                  depth) +
+ + 306                           FUNARG (APPLY (CADR function) args (CADDR function) depth) +
+ + 307                           LAMBDA (EVAL +
+ + 308                                   (CADDR function) +
+ + 309                                   (PAIRLIS (CADR function) args environment) depth) +
+ + 310                           (throw (ex-info "Ungecnáwen wyrþan sí þegnung-weard" +
+ + 311                                           {:phase :apply +
+ + 312                                            :function function +
+ + 313                                            :args args +
+ + 314                                            :type :beowulf}))))] +
+ + 315      (trace-response 'APPLY result depth) +
+ + 316      result)) +
+ + 317   +
+ + 318  ;;;; EVAL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 319   +
+ + 320  (defn- EVCON +
+ + 321    "Inner guts of primitive COND. All `clauses` are assumed to be +
+ + 322    `beowulf.cons-cell/ConsCell` objects. Note that tests in Lisp 1.5 +
+ + 323     often return `F`, not `NIL`, on failure. If no clause matches, +
+ + 324     then, strictly, we throw an error with code `:A3`. +
+ + 325   +
+ + 326     See pages 13 and 71 of the Lisp 1.5 Programmers Manual." +
+ + 327    [clauses env depth] +
+ + 328    (loop [clauses' clauses] +
+ + 329      (if-not (= clauses' NIL) +
+ + 330        (let [test (EVAL (CAAR clauses') env depth)] +
+ + 331          (if (not (#{NIL F} test)) +
+ + 332           ;; (and (not= test NIL) (not= test F)) +
+ + 333            (EVAL (CADAR clauses') env depth) +
+ + 334            (recur (.getCdr clauses')))) +
+ + 335        (if (:strict *options*) +
+ + 336          (throw (ex-info "Ne ġefōg dǣl in COND" +
+ + 337                          {:phase :eval +
+ + 338                           :function 'COND +
+ + 339                           :args (list clauses) +
+ + 340                           :type :lisp +
+ + 341                           :code :A3})) +
+ + 342          NIL)))) +
+ + 343   +
+ + 344  (defn- EVLIS +
+ + 345    "Map `EVAL` across this list of `args` in the context of this +
+ + 346    `env`ironment.All args are assumed to be `beowulf.cons-cell/ConsCell` objects. +
+ + 347    See page 13 of the Lisp 1.5 Programmers Manual." +
+ + 348    [args env depth] +
+ + 349    (cond +
+ + 350      (= NIL args) NIL +
+ + 351      :else +
+ + 352      (make-cons-cell +
+ + 353       (EVAL (CAR args) env depth) +
+ + 354       (EVLIS (CDR args) env depth)))) +
+ + 355   +
+ + 356  (defn- eval-symbolic +
+ + 357    [expr env depth] +
+ + 358    (let [v (ASSOC expr env) +
+ + 359          indent (apply str (repeat depth "-"))] +
+ + 360      (when (traced? 'EVAL) +
+ + 361        (println (str indent ": EVAL: sceald bindele: " (or v "nil")))) +
+ + 362      (if (instance? ConsCell v) +
+ + 363        (.getCdr v) +
+ + 364        (let [v' (value expr (list 'APVAL))] +
+ + 365          (when (traced? 'EVAL) +
+ + 366            (println (str indent ": EVAL: deóp bindele: (" expr " . " (or v' "nil") ")"))) +
+ + 367          (if v' +
+ + 368            v' +
+ + 369            (throw (ex-info "Ne tácen-bindele āfand" +
+ + 370                            {:phase :eval +
+ + 371                             :function 'EVAL +
+ + 372                             :args (list expr env depth) +
+ + 373                             :type :lisp +
+ + 374                             :code :A8}))))))) +
+ + 375   +
+ + 376  (defn EVAL +
+ + 377    "Evaluate this `expr` and return the result. If `environment` is not passed, +
+ + 378     it defaults to the current value of the global object list. The `depth` +
+ + 379     argument is part of the tracing system and should not be set by user code. +
+ + 380   +
+ + 381     All args are assumed to be numbers, symbols or `beowulf.cons-cell/ConsCell`  +
+ + 382     objects. However, if called with just a single arg, `expr`, I'll assume it's +
+ + 383     being called from the Clojure REPL and will coerce the `expr` to `ConsCell`." +
+ + 384    ([expr] +
+ + 385     (let [expr' (if (and (coll? expr) (not (instance? ConsCell expr))) +
+ + 386                   (make-beowulf-list expr) +
+ + 387                   expr)] +
+ + 388       (EVAL expr' NIL 0))) +
+ + 389    ([expr env depth] +
+ + 390     (trace-call 'EVAL (list expr env depth) depth) +
+ + 391     (let [result (cond +
+ + 392                    (= NIL expr) NIL ;; it was probably a mistake to make Lisp  +
+ + 393                                     ;; NIL distinct from Clojure nil +
+ + 394                    (= (NUMBERP expr) T) expr +
+ + 395                    (symbol? expr) (eval-symbolic expr env depth) +
+ + 396                    (string? expr) (if (:strict *options*) +
+ + 397                                     (throw +
+ + 398                                      (ex-info +
+ + 399                                       (str "EVAL: strings not allowed in strict mode: \"" expr "\"") +
+ + 400                                       {:phase  :eval +
+ + 401                                        :detail :strict +
+ + 402                                        :expr   expr})) +
+ + 403                                     (symbol expr)) +
+ + 404                    (= (ATOM (CAR expr)) T) (case (CAR expr) +
+ + 405                                              COND (EVCON (CDR expr) env depth) +
+ + 406                                              FUNCTION (LIST 'FUNARG (CADR expr)) +
+ + 407                                              PROG (PROG (CDR expr) env depth) +
+ + 408                                              QUOTE (CADR expr) +
+ + 409             ;; else  +
+ + 410                                              (APPLY +
+ + 411                                               (CAR expr) +
+ + 412                                               (EVLIS (CDR expr) env depth) +
+ + 413                                               env +
+ + 414                                               depth)) +
+ + 415                    :else (APPLY +
+ + 416                           (CAR expr) +
+ + 417                           (EVLIS (CDR expr) env depth) +
+ + 418                           env +
+ + 419                           depth))] +
+ + 420       (trace-response 'EVAL result depth) +
+ + 421       result))) +
+ + 422  
diff --git a/docs/cloverage/beowulf/cons_cell.clj.html b/docs/cloverage/beowulf/cons_cell.clj.html index 5a58211..a229691 100644 --- a/docs/cloverage/beowulf/cons_cell.clj.html +++ b/docs/cloverage/beowulf/cons_cell.clj.html @@ -11,466 +11,820 @@ 002    "The fundamental cons cell on which all Lisp structures are built.
- 003    Lisp 1.5 lists do not necessarily have a sequence as their CDR, so + 003    Lisp 1.5 lists do not necessarily have a sequence as their CDR, and
- 004    cannot be implemented on top of Clojure lists.") + 004    must have both CAR and CDR mutable, so cannot be implemented on top +
+ + 005    of Clojure lists." +
+ + 006    (:require [beowulf.oblist :refer [NIL]]))
- 005   -
- - 006  (def NIL + 007  
- 007    "The canonical empty list symbol." + 008  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- - 008    (symbol "NIL")) + + 009  ;;; +
+ + 010  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 011  ;;; +
+ + 012  ;;; This program is free software; you can redistribute it and/or +
+ + 013  ;;; modify it under the terms of the GNU General Public License +
+ + 014  ;;; as published by the Free Software Foundation; either version 2 +
+ + 015  ;;; of the License, or (at your option) any later version. +
+ + 016  ;;;  +
+ + 017  ;;; This program is distributed in the hope that it will be useful, +
+ + 018  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 019  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 020  ;;; GNU General Public License for more details. +
+ + 021  ;;;  +
+ + 022  ;;; You should have received a copy of the GNU General Public License +
+ + 023  ;;; along with this program; if not, write to the Free Software +
+ + 024  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 025  ;;; +
+ + 026  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 009   -
- - 010  (def T -
- - 011    "The canonical true value." -
- - 012    (symbol "T")) ;; true. -
- - 013   -
- - 014  (def F -
- - 015    "The canonical false value - different from `NIL`, which is not canonically -
- - 016    false in Lisp 1.5." -
- - 017    (symbol "F")) ;; false as distinct from nil -
- - 018   -
- - 019  (deftype ConsCell [CAR CDR] -
- - 020    clojure.lang.ISeq -
- - 021    (cons [this x] (ConsCell. x this)) -
- - 022    (first [this] (.CAR this)) -
- - 023    ;; next and more must return ISeq: -
- - 024    ;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java -
- - 025    (more [this] (if -
- - 026                   (seq? (.CDR this)) -
- - 027                   (.CDR this) -
- - 028                   clojure.lang.PersistentList/EMPTY)) -
- - 029    (next [this] (if -
- - 030                   (seq? (.CDR this)) -
- - 031                   (.CDR this) -
- - 032                   nil ;; next returns nil when empty -
- - 033                   )) -
- - 034   -
- - 035    clojure.lang.Seqable -
- - 036    (seq [this] this) -
- - 037   -
- - 038    ;; for some reason this marker protocol is needed otherwise compiler complains -
- - 039    ;; that `nth not supported on ConsCell` -
- - 040    clojure.lang.Sequential -
- - 041   -
- - 042    clojure.lang.IPersistentCollection -
- - 043    (count [this] (if -
- - 044                    (coll? (.CDR this)) -
- - 045                    (inc (.count (.CDR this))) -
- - 046                    1)) -
- - 047    (empty [this] false) ;; a cons cell is by definition not empty. -
- - 048    (equiv [this other] (if -
- - 049                          (seq? other) -
- - 050                          (and -
- - 051                            (if -
- - 052                              (and -
- - 053                                (seq? (first this)) -
- - 054                                (seq? (first other))) -
- - 055                              (.equiv (first this) (first other)) -
- - 056                              (= (first this) (first other))) -
- - 057                            (if -
- - 058                              (and -
- - 059                                (seq? (rest this)) -
- - 060                                (seq? (rest other))) -
- - 061                              (.equiv (rest this) (rest other)) -
- - 062                              (= (rest this) (rest other)))) -
- - 063                          false))) -
- - 064   + 027  
- 065  (defn- to-string + 028  (declare cons-cell?)
- - 066    "Printing ConsCells gave me a *lot* of trouble. This is an internal function -
- - 067    used by the print-method override (below) in order that the standard Clojure -
- - 068    `print` and `str` functions will print ConsCells correctly. The argument -
- - 069    `cell` must, obviously, be an instance of `ConsCell`." -
- - 070    [cell] -
- - 071    (loop [c cell -
- - 072           n 0 -
- - 073           s "("] + + 029  
- 074      (if + 030  (def T
- - 075        (instance? beowulf.cons_cell.ConsCell c) -
- - 076        (let [car (.CAR c) -
- - 077              cdr (.CDR c) -
- - 078              cons? (instance? beowulf.cons_cell.ConsCell cdr) -
- - 079              ss (str -
- - 080                   s + + 031    "The canonical true value."
- 081                   (to-string car) + 032    (symbol "T")) ;; true. +
+ + 033   +
+ + 034  (def F +
+ + 035    "The canonical false value - different from `NIL`, which is not canonically +
+ + 036    false in Lisp 1.5." +
+ + 037    (symbol "F")) ;; false as distinct from nil +
+ + 038   +
+ + 039  ;;;; The actual cons-cell ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 040   +
+ + 041  (defprotocol MutableSequence +
+ + 042    "Like a sequence, but mutable." +
+ + 043    (rplaca +
+ + 044      [this value] +
+ + 045      "replace the first element of this sequence with this value") +
+ + 046    (rplacd +
+ + 047      [this value] +
+ + 048      "replace the rest (but-first; cdr) of this sequence with this value") +
+ + 049    (getCar +
+ + 050      [this] +
+ + 051      "Return the first element of this sequence.") +
+ + 052    (getCdr +
+ + 053      [this] +
+ + 054      "like `more`, q.v., but returns List `NIL` not Clojure `nil` when empty.") +
+ + 055    (getUid +
+ + 056      [this] +
+ + 057      "Returns a unique identifier for this object")) +
+ + 058   +
+ + 059  (deftype ConsCell [^:unsynchronized-mutable CAR ^:unsynchronized-mutable CDR uid] +
+ + 060    ;; Note that, because the CAR and CDR fields are unsynchronised mutable - i.e. +
+ + 061    ;; plain old Java instance variables which can be written as well as read - +
+ + 062    ;; ConsCells are NOT thread safe. This does not matter, since Lisp 1.5 is +
+ + 063    ;; single threaded. +
+ + 064    MutableSequence +
+ + 065   +
+ + 066    (rplaca [this value] +
+ + 067      (if +
+ + 068       (or +
+ + 069        (satisfies? MutableSequence value) ;; can't reference +
+ + 070                ;; beowulf.cons_cell.ConsCell, +
+ + 071                ;; because it is not yet +
+ + 072                ;; defined +
+ + 073        (cons-cell? value) +
+ + 074        (number? value) +
+ + 075        (symbol? value)) +
+ + 076        (do +
+ + 077          (set! (. this CAR) value) +
+ + 078          this) +
+ + 079        (throw (ex-info +
+ + 080                (str "Uncynlic miercels in RPLACA: `" value "` (" (type value) ")") +
+ + 081                {:cause  :bad-value +
+ + 082                 :detail :rplaca})))) +
+ + 083   +
+ + 084    (rplacd [this value] +
+ + 085      (if +
+ + 086       (or +
+ + 087        (satisfies? MutableSequence value) +
+ + 088        (cons-cell? value) +
+ + 089        (number? value) +
+ + 090        (symbol? value)) +
+ + 091        (do +
+ + 092          (set! (. this CDR) value) +
+ + 093          this) +
+ + 094        (throw (ex-info +
+ + 095                (str "Uncynlic miercels in RPLACD: `" value "` (" (type value) ")") +
+ + 096                {:cause  :bad-value +
+ + 097                 :detail :rplaca})))) +
+ + 098   +
+ + 099    (getCar [this] +
+ + 100      (. this CAR)) +
+ + 101    (getCdr [this] +
+ + 102      (. this CDR)) +
+ + 103    (getUid [this] +
+ + 104      (. this uid)) +
+ + 105   +
+ + 106    clojure.lang.ISeq +
+ + 107    (cons [this x] (ConsCell. x this (gensym "c"))) +
+ + 108    (first [this] (.CAR this)) +
+ + 109    ;; next and more must return ISeq: +
+ + 110    ;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java +
+ + 111    (more [this] (if +
+ + 112                  (seq? (.getCdr this)) +
+ + 113                   (.getCdr this) +
+ + 114                   clojure.lang.PersistentList/EMPTY)) +
+ + 115    (next [this] (if +
+ + 116                  (seq? (.getCdr this)) +
+ + 117                   (.getCdr this) +
+ + 118                   nil ;; next returns nil when empty +
+ + 119                   )) +
+ + 120   +
+ + 121    clojure.lang.Seqable +
+ + 122    (seq [this] this) +
+ + 123   +
+ + 124    ;; for some reason this marker protocol is needed otherwise compiler complains +
+ + 125    ;; that `nth not supported on ConsCell` +
+ + 126    clojure.lang.Sequential +
+ + 127   +
+ + 128    clojure.lang.IPersistentCollection +
+ + 129    (empty [this] (= this NIL)) ;; a cons cell is by definition not empty. +
+ + 130    (equiv [this other] (if +
+ + 131                         (seq? other) +
+ + 132                          (and +
+ + 133                           (if
- 082                   (cond + 134                            (and
- - 083                     cons? + + 135                             (seq? (first this))
- - 084                     " " -
- - 085                     (or (nil? cdr) (= cdr 'NIL)) -
- - 086                     ")" -
- - 087                     :else + + 136                             (seq? (first other)))
- 088                     (str " . " (to-string cdr) ")")))] + 137                             (.equiv (first this) (first other))
- - 089          (if + + 138                             (= (first this) (first other)))
- - 090            cons? + + 139                           (if
- - 091            (recur cdr (inc n) ss) -
- - 092            ss)) + + 140                            (and
- 093        (str c)))) + 141                             (seq? (.getCdr this)) +
+ + 142                             (seq? (.getCdr other))) +
+ + 143                             (.equiv (.getCdr this) (.getCdr other)) +
+ + 144                             (= (.getCdr this) (.getCdr other)))) +
+ + 145                          false))
- 094   -
- - 095  (defn pretty-print + 146  
- 096    "This isn't the world's best pretty printer but it sort of works." -
- - 097    ([^beowulf.cons_cell.ConsCell cell] -
- - 098     (println (pretty-print cell 80 0))) -
- - 099    ([^beowulf.cons_cell.ConsCell cell width level] + 147    clojure.lang.Counted
- 100     (loop [c cell -
- - 101            n (inc level) + 148    (count [this] (loop [cell this
- 102            s "("] + 149                         result 1]
- 103       (if -
- - 104         (instance? beowulf.cons_cell.ConsCell c) -
- - 105         (let [car (.CAR c) -
- - 106               cdr (.CDR c) -
- - 107               cons? (instance? beowulf.cons_cell.ConsCell cdr) -
- - 108               print-width (count (print-str c)) -
- - 109               indent (apply str (repeat n "  ")) -
- - 110               ss (str -
- - 111                    s -
- - 112                    (pretty-print car width n) -
- - 113                    (cond -
- - 114                      cons? -
- - 115                      (if -
- - 116                        (< (+ (count indent) print-width) width) -
- - 117                        " " -
- - 118                        (str "\n" indent)) + 150                    (if
- 119                      (or (nil? cdr) (= cdr 'NIL)) + 151                     (and (coll? (.getCdr cell)) (not= NIL (.getCdr cell))) +
+ + 152                      (recur (.getCdr cell) (inc result)) +
+ + 153                      result))) +
+ + 154  
- 120                      ")" + 155    java.lang.Object
- 121                      :else -
- - 122                      (str " . " (pretty-print cdr width n) ")")))] -
- - 123           (if -
- - 124             cons? -
- - 125             (recur cdr n ss) -
- - 126             ss)) + 156    (toString [this]
- 127         (str c))))) -
- - 128   -
- - 129   -
- - 130   -
- - 131  (defmethod clojure.core/print-method -
- - 132    ;;; I have not worked out how to document defmethod without blowing up the world. -
- - 133    beowulf.cons_cell.ConsCell -
- - 134    [this writer] -
- - 135    (.write writer (to-string this))) -
- - 136   -
- - 137   -
- - 138  (defmacro make-cons-cell -
- - 139    "Construct a new instance of cons cell with this `car` and `cdr`." -
- - 140    [car cdr] -
- - 141    `(ConsCell. ~car ~cdr)) -
- - 142   -
- - 143  (defn make-beowulf-list -
- - 144    "Construct a linked list of cons cells with the same content as the -
- - 145    sequence `x`." -
- - 146    [x] -
- - 147    (cond -
- - 148      (empty? x) NIL -
- - 149      (coll? x) (ConsCell. -
- - 150                  (if -
- - 151                    (seq? (first x)) -
- - 152                    (make-beowulf-list (first x)) -
- - 153                    (first x)) -
- - 154                  (make-beowulf-list (rest x))) -
- - 155      :else + 157      (str "("
- 156      NIL)) + 158           (. this CAR) +
+ + 159           (cond +
+ + 160             (instance? ConsCell (. this CDR)) (str " " (subs (.toString (. this CDR)) 1)) +
+ + 161             (= NIL (. this CDR)) ")" +
+ + 162             :else (str " . " (. this CDR) ")"))))) +
+ + 163   +
+ + 164  ;;;; Printing. Here be dragons! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 165   +
+ + 166  (defn- to-string +
+ + 167    "Printing ConsCells gave me a *lot* of trouble. This is an internal function +
+ + 168    used by the print-method override (below) in order that the standard Clojure +
+ + 169    `print` and `str` functions will print ConsCells correctly. The argument +
+ + 170    `cell` must, obviously, be an instance of `ConsCell`." +
+ + 171    ;; TODO: I am deeply suspicious both of this and the defmethod which depends  +
+ + 172    ;; on it. I *think* they are implicated in the `COPY` bug. If the `toString` +
+ + 173    ;; override in `ConsCell` was right, neither of these would be necessary. +
+ + 174    ;; see https://github.com/simon-brooke/beowulf/issues/5 +
+ + 175    [cell] +
+ + 176    (loop [c cell +
+ + 177           n 0 +
+ + 178           s "("] +
+ + 179      (if +
+ + 180       (instance? beowulf.cons_cell.ConsCell c) +
+ + 181        (let [car (.first c) +
+ + 182              cdr (.getCdr c) +
+ + 183              cons? (and +
+ + 184                     (instance? beowulf.cons_cell.ConsCell cdr) +
+ + 185                     (not (nil? cdr)) +
+ + 186                     (not= cdr NIL)) +
+ + 187              ss (str +
+ + 188                  s +
+ + 189                  (to-string car) +
+ + 190                  (cond +
+ + 191                    (or (nil? cdr) (= cdr NIL)) ")" +
+ + 192                    cons?  " " +
+ + 193                    :else (str " . " (to-string cdr) ")")))] +
+ + 194          (if +
+ + 195           cons? +
+ + 196            (recur cdr (inc n) ss) +
+ + 197            ss)) +
+ + 198        (str c)))) +
+ + 199   +
+ + 200  (defmethod clojure.core/print-method +
+ + 201    ;;; I have not worked out how to document defmethod without blowing up the world. +
+ + 202    beowulf.cons_cell.ConsCell +
+ + 203    [this writer] +
+ + 204    (.write writer (to-string this))) +
+ + 205   +
+ + 206  (defn pretty-print +
+ + 207    "This isn't the world's best pretty printer but it sort of works." +
+ + 208    ([cell] +
+ + 209     (println (pretty-print cell 80 0))) +
+ + 210    ([cell width level] +
+ + 211     (loop [c cell +
+ + 212            n (inc level) +
+ + 213            s "("] +
+ + 214       (if +
+ + 215        (instance? beowulf.cons_cell.ConsCell c) +
+ + 216         (let [car (.first c) +
+ + 217               cdr (.getCdr c) +
+ + 218               tail? (instance? beowulf.cons_cell.ConsCell cdr) +
+ + 219               print-width (count (print-str c)) +
+ + 220               indent (apply str (repeat n "  ")) +
+ + 221               ss (str +
+ + 222                   s +
+ + 223                   (pretty-print car width n) +
+ + 224                   (cond +
+ + 225                     (or (nil? cdr) (= cdr NIL)) +
+ + 226                     ")" +
+ + 227                     tail? +
+ + 228                     (if +
+ + 229                      (< (+ (count indent) print-width) width) +
+ + 230                       " " +
+ + 231                       (str "\n" indent)) +
+ + 232                     :else +
+ + 233                     (str " . " (pretty-print cdr width n) ")")))] +
+ + 234           (if +
+ + 235            tail? +
+ + 236             (recur cdr n ss) +
+ + 237             ss)) +
+ + 238         (str c))))) +
+ + 239   +
+ + 240  (defn cons-cell? +
+ + 241    "Is this object `o` a beowulf cons-cell?" +
+ + 242    [o] +
+ + 243    (instance? beowulf.cons_cell.ConsCell o)) +
+ + 244   +
+ + 245  (defn make-cons-cell +
+ + 246    "Construct a new instance of cons cell with this `car` and `cdr`." +
+ + 247    [car cdr] +
+ + 248    (try +
+ + 249      (ConsCell. car cdr (gensym "c")) +
+ + 250      (catch Exception any +
+ + 251        (throw (ex-info "Ne meahte cræfte cons cell" {:car car +
+ + 252                                                         :cdr cdr} any))))) +
+ + 253   +
+ + 254  (defn make-beowulf-list +
+ + 255    "Construct a linked list of cons cells with the same content as the +
+ + 256    sequence `x`." +
+ + 257    [x] +
+ + 258    (try +
+ + 259      (cond +
+ + 260        (empty? x) NIL +
+ + 261        (instance? ConsCell x) (make-cons-cell (.getCar x) (.getCdr x)) +
+ + 262        (coll? x) (ConsCell. +
+ + 263                   (if +
+ + 264                    (coll? (first x)) +
+ + 265                     (make-beowulf-list (first x)) +
+ + 266                     (first x)) +
+ + 267                   (make-beowulf-list (rest x)) +
+ + 268                   (gensym "c")) +
+ + 269        :else +
+ + 270        NIL) +
+ + 271      (catch Exception any +
+ + 272        (throw (ex-info "Ne meahte cræfte Beowulf líste" +
+ + 273                        {:content x} +
+ + 274                        any)))))
diff --git a/docs/cloverage/beowulf/core.clj.html b/docs/cloverage/beowulf/core.clj.html index 13189d9..209aa59 100644 --- a/docs/cloverage/beowulf/core.clj.html +++ b/docs/cloverage/beowulf/core.clj.html @@ -11,238 +11,394 @@ 002    "Essentially, the `-main` function and the bootstrap read-eval-print loop."
- 003    (:require [beowulf.bootstrap :refer [EVAL oblist *options*]] + 003    (:require [beowulf.bootstrap :refer [EVAL]]
- 004              [beowulf.read :refer [READ]] + 004              [beowulf.io :refer [default-sysout SYSIN]]
- 005              [clojure.java.io :as io] + 005              [beowulf.oblist :refer [*options* NIL]]
- 006              [clojure.pprint :refer [pprint]] + 006              [beowulf.read :refer [READ read-from-console]]
- 007              [clojure.tools.cli :refer [parse-opts]] + 007              [clojure.java.io :as io]
- 008              [environ.core :refer [env]]) + 008              [clojure.pprint :refer [pprint]]
- 009    (:gen-class)) + 009              [clojure.string :refer [trim]] +
+ + 010              [clojure.tools.cli :refer [parse-opts]]) +
+ + 011    (:gen-class))
- 010   -
- - 011  (def cli-options -
- - 012    [["-h" "--help"] -
- - 013     ["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT" + 012  
- 014      :default "Sprecan::"] -
- - 015     ["-r INITFILE" "--read INITFILE" "Read Lisp functions from the file INITFILE" -
- - 016      :validate [#(and -
- - 017                    (.exists (io/file %)) + 013  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 018                    (.canRead (io/file %))) + 014  ;;;
- 019                 "Could not find initfile"]] + 015  ;;; Copyright (C) 2022-2023 Simon Brooke
- - 020     ["-s" "--strict" "Strictly interpret the Lisp 1.5 language, without extensions."] + + 016  ;;;
- - 021     ["-t" "--trace" "Trace Lisp evaluation."]]) + + 017  ;;; This program is free software; you can redistribute it and/or +
+ + 018  ;;; modify it under the terms of the GNU General Public License +
+ + 019  ;;; as published by the Free Software Foundation; either version 2 +
+ + 020  ;;; of the License, or (at your option) any later version. +
+ + 021  ;;;  +
+ + 022  ;;; This program is distributed in the hope that it will be useful, +
+ + 023  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 024  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 025  ;;; GNU General Public License for more details. +
+ + 026  ;;;  +
+ + 027  ;;; You should have received a copy of the GNU General Public License +
+ + 028  ;;; along with this program; if not, write to the Free Software +
+ + 029  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 030  ;;; +
+ + 031  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 022   -
- - 023  (defn repl -
- - 024    "Read/eval/print loop." -
- - 025    [prompt] -
- - 026    (loop [] -
- - 027      (print prompt) + 032  
- 028      (flush) -
- - 029      (try -
- - 030        (let [input (read-line)] -
- - 031          (cond -
- - 032            (= input "quit") (throw (ex-info "\nFærwell!" {:cause :quit})) -
- - 033            input (println (str ">  " (print-str (EVAL (READ input) @oblist)))) -
- - 034            :else (println))) + 033  (def stop-word 
- 035        (catch + 034    "The word which, if submitted an an input line, will cause Beowulf to quit.
- 036          Exception + 035     Question: should this be `forlǣte`?"
- 037          e + 036    "STOP")
- - 038          (let [data (ex-data e)] -
- - 039            (println (.getMessage e)) + + 037  
- 040            (if -
- - 041              data + 038  (def cli-options
- 042              (case (:cause data) -
- - 043                :parse-failure (println (:failure data)) + 039    [["-f FILEPATH" "--file-path FILEPATH"
- 044                :strict nil ;; the message, which has already been printed, is enough. + 040      "Set the path to the directory for reading and writing Lisp files."
- - 045                :quit (throw e) + + 041      :validate [#(and (.exists (io/file %))
- - 046                ;; default + + 042                       (.isDirectory (io/file %)) +
+ + 043                       (.canRead (io/file %))
- 047                (pprint data)))))) -
- - 048      (recur))) -
- - 049   -
- - 050  (defn -main + 044                       (.canWrite (io/file %)))
- 051    "Parse options, print the banner, read the init file if any, and enter the -
- - 052    read/eval/print loop." -
- - 053    [& opts] -
- - 054    (let [args (parse-opts opts cli-options)] -
- - 055      (println -
- - 056        (str -
- - 057          "\nHider wilcuman. Béowulf is mín nama.\n" -
- - 058          (if -
- - 059            (System/getProperty "beowulf.version") -
- - 060            (str "Síðe " (System/getProperty "beowulf.version") "\n")) -
- - 061          (if -
- - 062            (:help (:options args)) + 045                 "File path must exist and must be a directory."]]
- 063            (:summary args)) + 046     ["-h" "--help"] +
+ + 047     ["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT" +
+ + 048      :default "Sprecan::"] +
+ + 049     ["-r SYSOUTFILE" "--read SYSOUTFILE" "Read Lisp system from file SYSOUTFILE" +
+ + 050      :default default-sysout +
+ + 051      :validate [#(and +
+ + 052                   (.exists (io/file %)) +
+ + 053                   (.canRead (io/file %))) +
+ + 054                 "Could not find sysout file"]]
- 064          (if (:errors args) + 055     ["-s" "--strict" "Strictly interpret the Lisp 1.5 language, without extensions."] +
+ + 056     ["-t" "--time" "Time evaluations."]]) +
+ + 057   +
+ + 058  (defn- re  +
+ + 059    "Like REPL, but it isn't a loop and doesn't print." +
+ + 060    [input] +
+ + 061    (EVAL (READ input) NIL 0)) +
+ + 062   +
+ + 063  (defn repl +
+ + 064    "Read/eval/print loop." +
+ + 065    [prompt] +
+ + 066    (loop [] +
+ + 067      (print prompt) +
+ + 068      (flush) +
+ + 069      (try
- 065            (apply str (interpose "; " (:errors args)))) -
- - 066          "\nSprecan 'quit' tó laéfan\n")) -
- - 067      (binding [*options* (:options args)] -
- - 068        (try -
- - 069          (repl (str (:prompt (:options args)) " ")) -
- - 070          (catch -
- - 071            Exception -
- - 072            e + 070        (if-let [input (trim (read-from-console))]
- 073            (let [data (ex-data e)] + 071          (if (= input stop-word)
- - 074              (if + + 072            (throw (ex-info "\nFærwell!" {:cause :quit}))
- - 075                data + + 073            (println  +
+ + 074             (str ">  " 
- 076                (case (:cause data) + 075                  (print-str (if (:time *options*) +
+ + 076                               (time (re input)) +
+ + 077                               (re input))))))  +
+ + 078          (println))
- 077                  :quit nil + 079        (catch
- 078                  ;; default + 080         Exception +
+ + 081         e +
+ + 082          (let [data (ex-data e)] +
+ + 083            (println (.getMessage e)) +
+ + 084            (when +
+ + 085             data +
+ + 086              (case (:cause data) +
+ + 087                :parse-failure (println (:failure data)) +
+ + 088                :strict nil ;; the message, which has already been printed, is enough. +
+ + 089                :quit (throw e) +
+ + 090                ;; default
- 079                  (pprint data)) + 091                (pprint data)))))) +
+ + 092      (recur))) +
+ + 093   +
+ + 094  (defn -main +
+ + 095    "Parse options, print the banner, read the init file if any, and enter the +
+ + 096    read/eval/print loop." +
+ + 097    [& opts] +
+ + 098    (let [args (parse-opts opts cli-options)] +
+ + 099      (println +
+ + 100       (str +
+ + 101        "\nHider wilcuman. Béowulf is mín nama.\n" +
+ + 102        (when +
+ + 103         (System/getProperty "beowulf.version") +
+ + 104          (str "Síðe " (System/getProperty "beowulf.version") "\n")) +
+ + 105        (when +
+ + 106         (:help (:options args))
- 080                (println e)))))))) + 107          (:summary args)) +
+ + 108        (when (:errors args) +
+ + 109          (apply str (interpose "; " (:errors args)))) +
+ + 110        "\nSprecan '" stop-word "' tó laéfan\n")) +
+ + 111       +
+ + 112      (binding [*options* (:options args)] +
+ + 113        ;; (pprint *options*) +
+ + 114        (when (:read *options*) +
+ + 115          (try (SYSIN (:read *options*)) +
+ + 116               (catch Throwable any +
+ + 117                 (println any)))) +
+ + 118        (try +
+ + 119          (repl (str (:prompt (:options args)) " ")) +
+ + 120          (catch +
+ + 121           Exception +
+ + 122           e +
+ + 123            (let [data (ex-data e)] +
+ + 124              (if +
+ + 125               data +
+ + 126                (case (:cause data) +
+ + 127                  :quit nil +
+ + 128                  ;; default +
+ + 129                  (do +
+ + 130                    (println "STÆFLEAHTER: " (.getMessage e)) +
+ + 131                    (pprint data))) +
+ + 132                (println e))))))))
diff --git a/docs/cloverage/beowulf/host.clj.html b/docs/cloverage/beowulf/host.clj.html index 3acdcf2..5a4bbed 100644 --- a/docs/cloverage/beowulf/host.clj.html +++ b/docs/cloverage/beowulf/host.clj.html @@ -14,10 +14,1708 @@ 003     be) implemented in Lisp 1.5, which therefore need to be implemented in the
- 004     host language, in this case Clojure.") + 004     host language, in this case Clojure." +
+ + 005    (:require [beowulf.cons-cell :refer [F make-beowulf-list make-cons-cell +
+ + 006                                         pretty-print T]] ;; note hyphen - this is Clojure... +
+ + 007              [beowulf.gendoc :refer [open-doc]] +
+ + 008              [beowulf.oblist :refer [*options* NIL oblist]] +
+ + 009              [clojure.set :refer [union]] +
+ + 010              [clojure.string :refer [upper-case]]) +
+ + 011    (:import [beowulf.cons_cell ConsCell] ;; note underscore - same namespace, but Java. +
+ + 012             ))
- 005   + 013   +
+ + 014  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 015  ;;; +
+ + 016  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 017  ;;; +
+ + 018  ;;; This program is free software; you can redistribute it and/or +
+ + 019  ;;; modify it under the terms of the GNU General Public License +
+ + 020  ;;; as published by the Free Software Foundation; either version 2 +
+ + 021  ;;; of the License, or (at your option) any later version. +
+ + 022  ;;;  +
+ + 023  ;;; This program is distributed in the hope that it will be useful, +
+ + 024  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 025  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 026  ;;; GNU General Public License for more details. +
+ + 027  ;;;  +
+ + 028  ;;; You should have received a copy of the GNU General Public License +
+ + 029  ;;; along with this program; if not, write to the Free Software +
+ + 030  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 031  ;;; +
+ + 032  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 033   +
+ + 034  ;; these are CANDIDATES to be host-implemented. only a subset of them MUST be. +
+ + 035  ;; those which can be implemented in Lisp should be, since that aids +
+ + 036  ;; portability. +
+ + 037   +
+ + 038   +
+ + 039  (defn lax? +
+ + 040    "Are we in lax mode? If so. return true; is not, throw an exception with  +
+ + 041     this `symbol`." +
+ + 042    [symbol] +
+ + 043    (when (:strict *options*) +
+ + 044      (throw (ex-info (format "%s ne āfand innan Lisp 1.5" symbol) +
+ + 045                      {:type :strict +
+ + 046                       :phase :host +
+ + 047                       :function symbol}))) +
+ + 048    true) +
+ + 049   +
+ + 050  ;;;; Basic operations on cons cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 051   +
+ + 052  (defn CONS +
+ + 053    "Construct a new instance of cons cell with this `car` and `cdr`." +
+ + 054    [car cdr] +
+ + 055    (beowulf.cons_cell.ConsCell. car cdr (gensym "c"))) +
+ + 056   +
+ + 057  (defn CAR +
+ + 058    "Return the item indicated by the first pointer of a pair. NIL is treated +
+ + 059    specially: the CAR of NIL is NIL." +
+ + 060    [x] +
+ + 061    (cond +
+ + 062      (= x NIL) NIL +
+ + 063      (instance? ConsCell x) (or (.getCar x) NIL) +
+ + 064      :else  (throw (ex-info +
+ + 065                     (str "Ne can tace CAR of `" x "` (" (.getName (.getClass x)) ")") +
+ + 066                     {:phase :host +
+ + 067                      :function 'CAR +
+ + 068                      :args (list x) +
+ + 069                      :type :beowulf})))) +
+ + 070   +
+ + 071  (defn CDR +
+ + 072    "Return the item indicated by the second pointer of a pair. NIL is treated +
+ + 073    specially: the CDR of NIL is NIL." +
+ + 074    [x] +
+ + 075    (cond +
+ + 076      (= x NIL) NIL +
+ + 077      (instance? ConsCell x) (or (.getCdr x) NIL) +
+ + 078      :else  (throw (ex-info +
+ + 079                     (str "Ne can tace CDR of `" x "` (" (.getName (.getClass x)) ")") +
+ + 080                     {:phase :host +
+ + 081                      :function 'CDR +
+ + 082                      :args (list x) +
+ + 083                      :type :beowulf})))) +
+ + 084   +
+ + 085   +
+ + 086  (defn uaf +
+ + 087    "Universal access function; `l` is expected to be an arbitrary LISP list, `path` +
+ + 088    a (clojure) list of the characters `a` and `d`. Intended to make declaring +
+ + 089    all those fiddly `#'c[ad]+r'` functions a bit easier" +
+ + 090    [l path] +
+ + 091    (cond +
+ + 092      (= l NIL) NIL +
+ + 093      (empty? path) l +
+ + 094      :else +
+ + 095      (try +
+ + 096        (case (last path) +
+ + 097          \a (uaf (.first l) (butlast path)) +
+ + 098          \d (uaf (.getCdr l) (butlast path)) +
+ + 099          (throw (ex-info (str "uaf: unexpected letter in path (only `a` and `d` permitted): " (last path)) +
+ + 100                          {:cause  :uaf +
+ + 101                           :detail :unexpected-letter +
+ + 102                           :expr   (last path)}))) +
+ + 103        (catch ClassCastException e +
+ + 104          (throw (ex-info +
+ + 105                  (str "uaf: Not a LISP list? " (type l)) +
+ + 106                  {:cause  :uaf +
+ + 107                   :detail :not-a-lisp-list +
+ + 108                   :expr   l} +
+ + 109                  e)))))) +
+ + 110   +
+ + 111  (defmacro CAAR [x] `(uaf ~x '(\a \a))) +
+ + 112  (defmacro CADR [x] `(uaf ~x '(\a \d))) +
+ + 113  (defmacro CDDR [x] `(uaf ~x '(\d \d))) +
+ + 114  (defmacro CDAR [x] `(uaf ~x '(\d \a))) +
+ + 115   +
+ + 116  (defmacro CAAAR [x] `(uaf ~x '(\a \a \a))) +
+ + 117  (defmacro CAADR [x] `(uaf ~x '(\a \a \d))) +
+ + 118  (defmacro CADAR [x] `(uaf ~x '(\a \d \a))) +
+ + 119  (defmacro CADDR [x] `(uaf ~x '(\a \d \d))) +
+ + 120  (defmacro CDDAR [x] `(uaf ~x '(\d \d \a))) +
+ + 121  (defmacro CDDDR [x] `(uaf ~x '(\d \d \d))) +
+ + 122  (defmacro CDAAR [x] `(uaf ~x '(\d \a \a))) +
+ + 123  (defmacro CDADR [x] `(uaf ~x '(\d \a \d))) +
+ + 124   +
+ + 125  (defmacro CAAAAR [x] `(uaf ~x '(\a \a \a \a))) +
+ + 126  (defmacro CAADAR [x] `(uaf ~x '(\a \a \d \a))) +
+ + 127  (defmacro CADAAR [x] `(uaf ~x '(\a \d \a \a))) +
+ + 128  (defmacro CADDAR [x] `(uaf ~x '(\a \d \d \a))) +
+ + 129  (defmacro CDDAAR [x] `(uaf ~x '(\d \d \a \a))) +
+ + 130  (defmacro CDDDAR [x] `(uaf ~x '(\d \d \d \a))) +
+ + 131  (defmacro CDAAAR [x] `(uaf ~x '(\d \a \a \a))) +
+ + 132  (defmacro CDADAR [x] `(uaf ~x '(\d \a \d \a))) +
+ + 133  (defmacro CAAADR [x] `(uaf ~x '(\a \a \a \d))) +
+ + 134  (defmacro CAADDR [x] `(uaf ~x '(\a \a \d \d))) +
+ + 135  (defmacro CADADR [x] `(uaf ~x '(\a \d \a \d))) +
+ + 136  (defmacro CADDDR [x] `(uaf ~x '(\a \d \d \d))) +
+ + 137  (defmacro CDDADR [x] `(uaf ~x '(\d \d \a \d))) +
+ + 138  (defmacro CDDDDR [x] `(uaf ~x '(\d \d \d \d))) +
+ + 139  (defmacro CDAADR [x] `(uaf ~x '(\d \a \a \d))) +
+ + 140  (defmacro CDADDR [x] `(uaf ~x '(\d \a \d \d))) +
+ + 141   +
+ + 142  (defn RPLACA +
+ + 143    "Replace the CAR pointer of this `cell` with this `value`. Dangerous, should +
+ + 144    really not exist, but does in Lisp 1.5 (and was important for some +
+ + 145    performance hacks in early Lisps)" +
+ + 146    [^ConsCell cell value] +
+ + 147    (if +
+ + 148     (instance? ConsCell cell) +
+ + 149      (if +
+ + 150       (or +
+ + 151        (instance? ConsCell value) +
+ + 152        (number? value) +
+ + 153        (symbol? value) +
+ + 154        (= value NIL)) +
+ + 155        (try +
+ + 156          (.rplaca cell value) +
+ + 157          cell +
+ + 158          (catch Throwable any +
+ + 159            (throw (ex-info +
+ + 160                    (str (.getMessage any) " in RPLACA: `") +
+ + 161                    {:cause :upstream-error +
+ + 162                     :phase :host +
+ + 163                     :function :rplaca +
+ + 164                     :args (list cell value) +
+ + 165                     :type :beowulf} +
+ + 166                    any)))) +
+ + 167        (throw (ex-info +
+ + 168                (str "Un-ġefōg þing in RPLACA: `" value "` (" (type value) ")") +
+ + 169                {:cause :bad-value +
+ + 170                 :phase :host +
+ + 171                 :function :rplaca +
+ + 172                 :args (list cell value) +
+ + 173                 :type :beowulf}))) +
+ + 174      (throw (ex-info +
+ + 175              (str "Uncynlic miercels in RPLACA: `" cell "` (" (type cell) ")") +
+ + 176              {:cause :bad-cell +
+ + 177               :phase :host +
+ + 178               :function :rplaca +
+ + 179               :args (list cell value) +
+ + 180               :type :beowulf})))) +
+ + 181   +
+ + 182  (defn RPLACD +
+ + 183    "Replace the CDR pointer of this `cell` with this `value`. Dangerous, should +
+ + 184    really not exist, but does in Lisp 1.5 (and was important for some +
+ + 185    performance hacks in early Lisps)" +
+ + 186    [^ConsCell cell value] +
+ + 187    (if +
+ + 188     (instance? ConsCell cell) +
+ + 189      (if +
+ + 190       (or +
+ + 191        (instance? ConsCell value) +
+ + 192        (number? value) +
+ + 193        (symbol? value) +
+ + 194        (= value NIL)) +
+ + 195        (try +
+ + 196          (.rplacd cell value) +
+ + 197          cell +
+ + 198          (catch Throwable any +
+ + 199            (throw (ex-info +
+ + 200                    (str (.getMessage any) " in RPLACD: `") +
+ + 201                    {:cause :upstream-error +
+ + 202                     :phase :host +
+ + 203                     :function :rplacd +
+ + 204                     :args (list cell value) +
+ + 205                     :type :beowulf} +
+ + 206                    any)))) +
+ + 207        (throw (ex-info +
+ + 208                (str "Un-ġefōg þing in RPLACD: `" value "` (" (type value) ")") +
+ + 209                {:cause :bad-value +
+ + 210                 :phase :host +
+ + 211                 :function :rplacd +
+ + 212                 :args (list cell value) +
+ + 213                 :type :beowulf}))) +
+ + 214      (throw (ex-info +
+ + 215              (str "Uncynlic miercels in RPLACD: `" cell "` (" (type cell) ")") +
+ + 216              {:cause :bad-cell +
+ + 217               :phase :host +
+ + 218               :detail :rplacd +
+ + 219               :args (list cell value) +
+ + 220               :type :beowulf}))));; PLUS +
+ + 221   +
+ + 222  (defn LIST +
+ + 223    [& args] +
+ + 224    (make-beowulf-list args)) +
+ + 225   +
+ + 226  ;;;; Basic predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 227   +
+ + 228  (defmacro NULL +
+ + 229    "Returns `T` if and only if the argument `x` is bound to `NIL`; else `F`." +
+ + 230    [x] +
+ + 231    `(if (= ~x NIL) T F)) +
+ + 232   +
+ + 233  (defmacro NILP +
+ + 234    "Not part of LISP 1.5: `T` if `o` is `NIL`, else `NIL`." +
+ + 235    [x] +
+ + 236    `(if (= ~x NIL) T NIL)) +
+ + 237   +
+ + 238  (defn ATOM +
+ + 239    "Returns `T` if and only if the argument `x` is bound to an atom; else `F`. +
+ + 240    It is not clear to me from the documentation whether `(ATOM 7)` should return +
+ + 241    `T` or `F`. I'm going to assume `T`." +
+ + 242    [x] +
+ + 243    (if (or (symbol? x) (number? x)) T F)) +
+ + 244   +
+ + 245  (defmacro ATOM? +
+ + 246    "The convention of returning `F` from predicates, rather than `NIL`, is going +
+ + 247    to tie me in knots. This is a variant of `ATOM` which returns `NIL` +
+ + 248    on failure." +
+ + 249    [x] +
+ + 250    `(if (or (symbol? ~x) (number? ~x)) T NIL)) +
+ + 251   +
+ + 252  (defn EQ +
+ + 253    "Returns `T` if and only if both `x` and `y` are bound to the same atom, +
+ + 254    else `NIL`." +
+ + 255    [x y] +
+ + 256    (cond (and (instance? ConsCell x) +
+ + 257               (.equals x y)) T +
+ + 258          (and (= (ATOM x) T) (= x y)) T +
+ + 259          :else NIL)) +
+ + 260   +
+ + 261  (defn EQUAL +
+ + 262    "This is a predicate that is true if its two arguments are identical +
+ + 263    S-expressions, and false if they are different. (The elementary predicate +
+ + 264    `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is +
+ + 265    an example of a conditional expression inside a conditional expression. +
+ + 266   +
+ + 267    NOTE: returns `F` on failure, not `NIL`" +
+ + 268    [x y] +
+ + 269    (cond +
+ + 270      (= (ATOM x) T) (if (= x y) T F) +
+ + 271      (= (EQUAL (CAR x) (CAR y)) T) (EQUAL (CDR x) (CDR y)) +
+ + 272      :else F)) +
+ + 273   +
+ + 274  (defn AND +
+ + 275    "`T` if and only if none of my `args` evaluate to either `F` or `NIL`, +
+ + 276     else `F`. +
+ + 277      +
+ + 278     In `beowulf.host` principally because I don't yet feel confident to define +
+ + 279     varargs functions in Lisp." +
+ + 280    [& args] +
+ + 281    ;; (println "AND: " args " type: " (type args) " seq? " (seq? args)) +
+ + 282    ;; (println "  filtered: " (seq (filter #{F NIL} args))) +
+ + 283    (cond (= NIL args) T +
+ + 284          (seq? args) (if (seq (filter #{F NIL} args)) F T) +
+ + 285          :else T)) +
+ + 286   +
+ + 287   +
+ + 288  (defn OR +
+ + 289    "`T` if and only if at least one of my `args` evaluates to something other +
+ + 290    than either `F` or `NIL`, else `F`. +
+ + 291      +
+ + 292     In `beowulf.host` principally because I don't yet feel confident to define +
+ + 293     varargs functions in Lisp." +
+ + 294    [& args] +
+ + 295    ;; (println "OR: " args " type: " (type args) " seq? " (seq? args)) +
+ + 296    ;; (println "  filtered: " (seq (remove #{F NIL} args))) +
+ + 297    (cond (= NIL args) F +
+ + 298          (seq? args) (if (seq (remove #{F NIL} args)) T F) +
+ + 299          :else F)) +
+ + 300   +
+ + 301   +
+ + 302  ;;;; Operations on lists ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 303  ;; +
+ + 304  ;; TODO: These are candidates for moving to Lisp urgently! +
+ + 305   +
+ + 306  (defn ASSOC +
+ + 307    "If a is an association list such as the one formed by PAIRLIS in the above +
+ + 308    example, then assoc will produce the first pair whose first term is x. Thus +
+ + 309    it is a table searching function. +
+ + 310   +
+ + 311    All args are assumed to be `beowulf.cons-cell/ConsCell` objects. +
+ + 312    See page 12 of the Lisp 1.5 Programmers Manual. +
+ + 313      +
+ + 314     **NOTE THAT** this function is overridden by an implementation in Lisp, +
+ + 315     but is currently still present for bootstrapping." +
+ + 316    [x a] +
+ + 317    (cond +
+ + 318      (= NIL a) NIL ;; this clause is not present in the original but is added for +
+ + 319      ;; robustness. +
+ + 320      (= (EQUAL (CAAR a) x) T) (CAR a) +
+ + 321      :else +
+ + 322      (ASSOC x (CDR a)))) +
+ + 323   +
+ + 324  (defn PAIRLIS +
+ + 325    "This function gives the list of pairs of corresponding elements of the +
+ + 326    lists `x` and `y`, and APPENDs this to the list `a`. The resultant list +
+ + 327    of pairs, which is like a table with two columns, is called an +
+ + 328    association list. +
+ + 329   +
+ + 330    Eessentially, it builds the environment on the stack, implementing shallow +
+ + 331    binding. +
+ + 332   +
+ + 333    All args are assumed to be `beowulf.cons-cell/ConsCell` objects. +
+ + 334    See page 12 of the Lisp 1.5 Programmers Manual. +
+ + 335      +
+ + 336     **NOTE THAT** this function is overridden by an implementation in Lisp, +
+ + 337     but is currently still present for bootstrapping." +
+ + 338    [x y a] +
+ + 339    (cond +
+ + 340      ;; the original tests only x; testing y as well will be a little more +
+ + 341      ;; robust if `x` and `y` are not the same length. +
+ + 342      (or (= NIL x) (= NIL y)) a +
+ + 343      :else (make-cons-cell +
+ + 344             (make-cons-cell (CAR x) (CAR y)) +
+ + 345             (PAIRLIS (CDR x) (CDR y) a)))) +
+ + 346   +
+ + 347  ;;;; Arithmetic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 348  ;; +
+ + 349  ;; TODO: When in strict mode, should we limit arithmetic precision to that +
+ + 350  ;; supported by Lisp 1.5? +
+ + 351   +
+ + 352  (defn PLUS +
+ + 353    [& args] +
+ + 354    (let [s (apply + args)] +
+ + 355      (if (integer? s) s (float s)))) +
+ + 356   +
+ + 357  (defn TIMES +
+ + 358    [& args] +
+ + 359    (let [p (apply * args)] +
+ + 360      (if (integer? p) p (float p)))) +
+ + 361   +
+ + 362  (defn DIFFERENCE +
+ + 363    [x y] +
+ + 364    (let [d (- x y)] +
+ + 365      (if (integer? d) d (float d)))) +
+ + 366   +
+ + 367  (defn QUOTIENT +
+ + 368    "I'm not certain from the documentation whether Lisp 1.5 `QUOTIENT` returned +
+ + 369    the integer part of the quotient, or a realnum representing the whole +
+ + 370    quotient. I am for now implementing the latter." +
+ + 371    [x y] +
+ + 372    (let [q (/ x y)] +
+ + 373      (if (integer? q) q (float q)))) +
+ + 374   +
+ + 375  (defn REMAINDER +
+ + 376    [x y] +
+ + 377    (rem x y)) +
+ + 378   +
+ + 379  (defn ADD1 +
+ + 380    [x] +
+ + 381    (inc x)) +
+ + 382   +
+ + 383  (defn SUB1 +
+ + 384    [x] +
+ + 385    (dec x)) +
+ + 386   +
+ + 387  (defn FIXP +
+ + 388    [x] +
+ + 389    (if (integer? x) T F)) +
+ + 390   +
+ + 391  (defn NUMBERP +
+ + 392    [x] +
+ + 393    (if (number? x) T F)) +
+ + 394   +
+ + 395  (defn LESSP +
+ + 396    [x y] +
+ + 397    (if (< x y) T F)) +
+ + 398   +
+ + 399  (defn GREATERP +
+ + 400    [x y] +
+ + 401    (if (> x y) T F)) +
+ + 402   +
+ + 403  ;;;; Miscellaneous ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 404   +
+ + 405  (defn GENSYM +
+ + 406    "Generate a unique symbol." +
+ + 407    [] +
+ + 408    (symbol (upper-case (str (gensym "SYM"))))) +
+ + 409   +
+ + 410  (defn ERROR +
+ + 411    "Throw an error" +
+ + 412    [& args] +
+ + 413    (throw (ex-info "LISP STÆFLEAHTER" {:args args +
+ + 414                                        :phase :eval +
+ + 415                                        :function 'ERROR +
+ + 416                                        :type :lisp +
+ + 417                                        :code (or (first args) 'A1)}))) +
+ + 418   +
+ + 419  ;;;; Assignment and the object list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 420   +
+ + 421  (defn OBLIST +
+ + 422    "Return a list of the symbols currently bound on the object list. +
+ + 423      +
+ + 424     **NOTE THAT** in the Lisp 1.5 manual, footnote at the bottom of page 69, it implies  +
+ + 425     that an argument can be passed but I'm not sure of the semantics of +
+ + 426     this." +
+ + 427    [] +
+ + 428    (if (instance? ConsCell @oblist) +
+ + 429      (make-beowulf-list (map CAR @oblist)) +
+ + 430      NIL)) +
+ + 431   +
+ + 432  (def magic-marker +
+ + 433    "The unexplained magic number which marks the start of a property list." +
+ + 434    (Integer/parseInt "77777" 8)) +
+ + 435   +
+ + 436  (defn PUT +
+ + 437    "Put this `value` as the value of the property indicated by this `indicator`  +
+ + 438     of this `symbol`. Return `value` on success. +
+ + 439      +
+ + 440     NOTE THAT there is no `PUT` defined in the manual, but it would have been  +
+ + 441     easy to have defined it so I don't think this fully counts as an extension." +
+ + 442    [symbol indicator value] +
+ + 443    (if-let [binding (ASSOC symbol @oblist)] +
+ + 444      (if-let [prop (ASSOC indicator (CDDR binding))] +
+ + 445        (RPLACD prop value) +
+ + 446        (RPLACD binding +
+ + 447                (make-cons-cell +
+ + 448                 magic-marker +
+ + 449                 (make-cons-cell +
+ + 450                  indicator +
+ + 451                  (make-cons-cell value (CDDR binding)))))) +
+ + 452      (swap! +
+ + 453       oblist +
+ + 454       (fn [ob s p v] +
+ + 455         (make-cons-cell +
+ + 456          (make-beowulf-list (list s magic-marker p v)) +
+ + 457          ob)) +
+ + 458       symbol indicator value))) +
+ + 459   +
+ + 460  (defn GET +
+ + 461    "From the manual: +
+ + 462      +
+ + 463     '`get` is somewhat like `prop`; however its value is car of the rest of +
+ + 464     the list if the `indicator` is found, and NIL otherwise.' +
+ + 465      +
+ + 466     It's clear that `GET` is expected to be defined in terms of `PROP`, but +
+ + 467     we can't implement `PROP` here because we lack `EVAL`; and we can't have +
+ + 468     `EVAL` here because both it and `APPLY` depends on `GET`. +
+ + 469      +
+ + 470     OK, It's worse than that: the statement of the definition of `GET` (and  +
+ + 471     of) `PROP` on page 59 says that the first argument to each must be a list; +
+ + 472     But the in the definition of `ASSOC` on page 70, when `GET` is called its +
+ + 473     first argument is always an atom. Since it's `ASSOC` and `EVAL` which I  +
+ + 474     need to make work, I'm going to assume that page 59 is wrong." +
+ + 475    [symbol indicator] +
+ + 476    (let [binding (ASSOC symbol @oblist) +
+ + 477          val (cond +
+ + 478                (= binding NIL) NIL +
+ + 479                (= magic-marker +
+ + 480                   (CADR binding)) (loop [b binding] +
+ + 481                                    ;;  (println "GET loop, seeking " indicator ":") +
+ + 482                                    ;;  (pretty-print b) +
+ + 483                                     (if (instance? ConsCell b) +
+ + 484                                       (if (= (CAR b) indicator) +
+ + 485                                         (CADR b) ;; <- this is what we should actually be returning +
+ + 486                                         (recur (CDR b))) +
+ + 487                                       NIL)) +
+ + 488                :else (throw +
+ + 489                       (ex-info "Misformatted property list (missing magic marker)" +
+ + 490                                {:phase :host +
+ + 491                                 :function :get +
+ + 492                                 :args (list symbol indicator) +
+ + 493                                 :type :beowulf})))] +
+ + 494      ;; (println "<< GET returning: " val) +
+ + 495      val)) +
+ + 496   +
+ + 497  (defn DEFLIST +
+ + 498    "For each pair in this association list `a-list`, set the property with this +
+ + 499     `indicator` of the symbol which is the first element of the pair to the  +
+ + 500     value which is the second element of the pair. See page 58 of the manual." +
+ + 501    [a-list indicator] +
+ + 502    (map +
+ + 503     #(PUT (CAR %) indicator (CDR %)) +
+ + 504     a-list)) +
+ + 505   +
+ + 506  (defn DEFINE +
+ + 507    "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten  +
+ + 508    in LISP.  +
+ + 509   +
+ + 510    The single argument to `DEFINE` should be an association list of symbols to +
+ + 511     lambda functions. See page 58 of the manual." +
+ + 512    [a-list] +
+ + 513    (DEFLIST a-list 'EXPR)) +
+ + 514   +
+ + 515  (defn SET +
+ + 516    "Implementation of SET in Clojure. Add to the `oblist` a binding of the +
+ + 517     value of `var` to the value of `val`. NOTE WELL: this is not SETQ!" +
+ + 518    [symbol val] +
+ + 519    (PUT symbol 'APVAL val)) +
+ + 520   +
+ + 521  ;;;; TRACE and friends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 522   +
+ + 523  (def traced-symbols +
+ + 524    "Symbols currently being traced." +
+ + 525    (atom #{})) +
+ + 526   +
+ + 527  (defn traced? +
+ + 528    "Return `true` iff `s` is a symbol currently being traced, else `nil`." +
+ + 529    [s] +
+ + 530    (try (contains? @traced-symbols s) +
+ + 531         (catch Throwable _ nil))) +
+ + 532   +
+ + 533  (defn TRACE +
+ + 534    "Add this `s` to the set of symbols currently being traced. If `s` +
+ + 535     is not a symbol or sequence of symbols, does nothing." +
+ + 536    [s] +
+ + 537    (swap! traced-symbols +
+ + 538           #(cond +
+ + 539              (symbol? s) (conj % s) +
+ + 540              (and (seq? s) (every? symbol? s)) (union % (set s)) +
+ + 541              :else %))) +
+ + 542   +
+ + 543  (defn UNTRACE +
+ + 544    "Remove this `s` from the set of symbols currently being traced. If `s` +
+ + 545     is not a symbol or sequence of symbols, does nothing." +
+ + 546    [s] +
+ + 547    (cond +
+ + 548      (symbol? s) (swap! traced-symbols #(set (remove (fn [x] (= s x)) %))) +
+ + 549      (and (seq? s) (every? symbol? s)) (map UNTRACE s)) +
+ + 550    @traced-symbols) +
+ + 551   +
+ + 552  ;;;; Extensions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 553   +
+ + 554  (defn DOC +
+ + 555    "Open the page for this `symbol` in the Lisp 1.5 manual, if known, in the  +
+ + 556      default web browser. +
+ + 557      +
+ + 558     **NOTE THAT** this is an extension function, not available in strct mode." +
+ + 559    [symbol] +
+ + 560    (when (lax? 'DOC) +
+ + 561      (open-doc symbol))) +
+ + 562   +
+ + 563  (defn CONSP +
+ + 564    "Return `T` if object `o` is a cons cell, else `F`. +
+ + 565      +
+ + 566     **NOTE THAT** this is an extension function, not available in strct mode.  +
+ + 567     I believe that Lisp 1.5 did not have any mechanism for testing whether an +
+ + 568     argument was, or was not, a cons cell." +
+ + 569    [o] +
+ + 570    (when (lax? 'CONSP) +
+ + 571      (if (instance? ConsCell o) 'T 'F)))
diff --git a/docs/cloverage/beowulf/interop.clj.html b/docs/cloverage/beowulf/interop.clj.html new file mode 100644 index 0000000..0dd6c5c --- /dev/null +++ b/docs/cloverage/beowulf/interop.clj.html @@ -0,0 +1,395 @@ + + + + beowulf/interop.clj + + + + 001  (ns beowulf.interop +
+ + 002    (:require [beowulf.cons-cell :refer [make-beowulf-list]] +
+ + 003              [beowulf.host :refer [CAR CDR]] +
+ + 004              [beowulf.oblist :refer [*options* NIL]] +
+ + 005              [clojure.string :as s :refer [last-index-of lower-case split +
+ + 006                                            upper-case]])) +
+ + 007   +
+ + 008  ;;;; INTEROP feature ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 009   +
+ + 010  (defn listify-qualified-name +
+ + 011    "We need to be able to print something we can link to the particular Clojure +
+ + 012     function `subr` in a form in which Lisp 1.5 is able to read it back in and +
+ + 013     relink it. +
+ + 014      +
+ + 015     This assumes `subr` is either  +
+ + 016     1. a string in the format `#'beowulf.io/SYSIN` or `beowulf.io/SYSIN`; or +
+ + 017     2. something which, when coerced to a string with `str`, will have such +
+ + 018        a format." +
+ + 019    [subr] +
+ + 020    (make-beowulf-list +
+ + 021     (map +
+ + 022      #(symbol (upper-case %)) +
+ + 023      (remove empty? (split (str subr) #"[#'./]"))))) +
+ + 024   +
+ + 025   +
+ + 026  (defn interpret-qualified-name +
+ + 027    "For interoperation with Clojure, it will often be necessary to pass +
+ + 028    qualified names that are not representable in Lisp 1.5. This function +
+ + 029    takes a sequence in the form `(PART PART PART... NAME)` and returns +
+ + 030    a symbol in the form `part.part.part/NAME`. This symbol will then be +
+ + 031    tried in both that form and lower-cased. Names with hyphens or +
+ + 032    underscores cannot be represented with this scheme." +
+ + 033    ([l] +
+ + 034     (symbol +
+ + 035      (let [n (s/join "."  +
+ + 036                      (concat (map #(lower-case (str %)) (butlast l))  +
+ + 037                              (list (last l)))) +
+ + 038            s (last-index-of n ".")] +
+ + 039        (if s +
+ + 040          (str (subs n 0 s) "/" (subs n (inc s))) +
+ + 041          n))))) +
+ + 042   +
+ + 043  (defn to-beowulf +
+ + 044    "Return a beowulf-native representation of the Clojure object `o`. +
+ + 045    Numbers and symbols are unaffected. Collections have to be converted; +
+ + 046    strings must be converted to symbols." +
+ + 047    [o] +
+ + 048    (cond +
+ + 049      (coll? o) (make-beowulf-list o) +
+ + 050      (string? o) (symbol (s/upper-case o)) +
+ + 051      :else o)) +
+ + 052   +
+ + 053  (defn to-clojure +
+ + 054    "If l is a `beowulf.cons_cell.ConsCell`, return a Clojure list having the  +
+ + 055    same members in the same order." +
+ + 056    [l] +
+ + 057    (cond +
+ + 058      (not (instance? beowulf.cons_cell.ConsCell l)) +
+ + 059      l +
+ + 060      (= (CDR l) NIL) +
+ + 061      (list (to-clojure (CAR l))) +
+ + 062      :else +
+ + 063      (conj (to-clojure (CDR l)) (to-clojure (CAR l))))) +
+ + 064   +
+ + 065  (defn INTEROP +
+ + 066    "Clojure (or other host environment) interoperation API. `fn-symbol` is expected +
+ + 067    to be either +
+ + 068   +
+ + 069    1. a symbol bound in the host environment to a function; or +
+ + 070    2. a sequence (list) of symbols forming a qualified path name bound to a +
+ + 071       function. +
+ + 072   +
+ + 073    Lower case characters cannot normally be represented in Lisp 1.5, so both the +
+ + 074    upper case and lower case variants of `fn-symbol` will be tried. If the +
+ + 075    function you're looking for has a mixed case name, that is not currently +
+ + 076    accessible. +
+ + 077   +
+ + 078    `args` is expected to be a Lisp 1.5 list of arguments to be passed to that +
+ + 079    function. Return value must be something acceptable to Lisp 1.5, so either +
+ + 080    a symbol, a number, or a Lisp 1.5 list. +
+ + 081   +
+ + 082    If `fn-symbol` is not found (even when cast to lower case), or is not a function, +
+ + 083    or the value returned cannot be represented in Lisp 1.5, an exception is thrown +
+ + 084    with `:cause` bound to `:interop` and `:detail` set to a value representing the +
+ + 085    actual problem." +
+ + 086    [fn-symbol args] +
+ + 087    (if-not (:strict *options*) +
+ + 088      (let +
+ + 089       [q-name (if +
+ + 090                (seq? fn-symbol) +
+ + 091                 (interpret-qualified-name fn-symbol) +
+ + 092                 fn-symbol) +
+ + 093        l-name (symbol (s/lower-case q-name)) +
+ + 094        f      (cond +
+ + 095                 (try +
+ + 096                   (fn? (eval l-name)) +
+ + 097                   (catch java.lang.ClassNotFoundException _ nil)) l-name +
+ + 098                 (try +
+ + 099                   (fn? (eval q-name)) +
+ + 100                   (catch java.lang.ClassNotFoundException _ nil)) q-name +
+ + 101                 :else (throw +
+ + 102                        (ex-info +
+ + 103                         (str "INTEROP: ungecnáwen þegnung `" fn-symbol "`") +
+ + 104                         {:cause      :interop +
+ + 105                          :detail     :not-found +
+ + 106                          :name       fn-symbol +
+ + 107                          :also-tried l-name}))) +
+ + 108        args'  (to-clojure args)] +
+ + 109  ;;      (print (str "INTEROP: eahtiende `" (cons f args') "`")) +
+ + 110        (flush) +
+ + 111        (let [result (eval (conj args' f))] ;; this has the potential to blow up the world +
+ + 112  ;;        (println (str "; ágiefende `" result "`")) +
+ + 113          (cond +
+ + 114            (instance? beowulf.cons_cell.ConsCell result) result +
+ + 115            (coll? result) (make-beowulf-list result) +
+ + 116            (symbol? result) result +
+ + 117            (string? result) (symbol result) +
+ + 118            (number? result) result +
+ + 119            :else (throw +
+ + 120                   (ex-info +
+ + 121                    (str "INTEROP: Ne can eahtiende `" result "` to Lisp 1.5.") +
+ + 122                    {:cause  :interop +
+ + 123                     :detail :not-representable +
+ + 124                     :result result}))))) +
+ + 125      (throw +
+ + 126       (ex-info +
+ + 127        (str "INTEROP ne āfand innan Lisp 1.5.") +
+ + 128        {:cause  :interop +
+ + 129         :detail :strict})))) +
+ + diff --git a/docs/cloverage/beowulf/io.clj.html b/docs/cloverage/beowulf/io.clj.html new file mode 100644 index 0000000..2ef3c37 --- /dev/null +++ b/docs/cloverage/beowulf/io.clj.html @@ -0,0 +1,521 @@ + + + + beowulf/io.clj + + + + 001  (ns beowulf.io +
+ + 002    "Non-standard extensions to Lisp 1.5 to read and write to the filesystem. +
+ + 003      +
+ + 004     Lisp 1.5 had only `READ`, which read one S-Expression at a time, and  +
+ + 005     various forms of `PRIN*` functions, which printed to the line printer.  +
+ + 006     There was also `PUNCH`, which wrote to a card punch. It does not seem  +
+ + 007     that there was any concept of an interactive terminal. +
+ + 008      +
+ + 009     See Appendix E, `OVERLORD - THE MONITOR`, and Appendix F, `LISP INPUT +
+ + 010     AND OUTPUT`. +
+ + 011      +
+ + 012     For our purposes, to save the current state of the Lisp system it should +
+ + 013     be sufficient to print the current contents of the oblist to file; and to +
+ + 014     restore a previous state from file, to overwrite the contents of the  +
+ + 015     oblist with data from that file. +
+ + 016      +
+ + 017     Hence functions SYSOUT and SYSIN, which do just that." +
+ + 018    (:require [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell +
+ + 019                                         pretty-print]] +
+ + 020              [beowulf.host :refer [CADR CAR CDDR CDR]] +
+ + 021              [beowulf.interop :refer [interpret-qualified-name +
+ + 022                                       listify-qualified-name]] +
+ + 023              [beowulf.oblist :refer [*options* NIL oblist]] +
+ + 024              [beowulf.read :refer [READ]] +
+ + 025              [clojure.java.io :refer [file resource]] +
+ + 026              [clojure.string :refer [ends-with?]] +
+ + 027              [java-time.api :refer [local-date local-date-time]])) +
+ + 028   +
+ + 029  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 030  ;;; +
+ + 031  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 032  ;;; +
+ + 033  ;;; This program is free software; you can redistribute it and/or +
+ + 034  ;;; modify it under the terms of the GNU General Public License +
+ + 035  ;;; as published by the Free Software Foundation; either version 2 +
+ + 036  ;;; of the License, or (at your option) any later version. +
+ + 037  ;;;  +
+ + 038  ;;; This program is distributed in the hope that it will be useful, +
+ + 039  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 040  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 041  ;;; GNU General Public License for more details. +
+ + 042  ;;;  +
+ + 043  ;;; You should have received a copy of the GNU General Public License +
+ + 044  ;;; along with this program; if not, write to the Free Software +
+ + 045  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 046  ;;; +
+ + 047  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 048   +
+ + 049  (def ^:constant default-sysout "lisp1.5.lsp") +
+ + 050   +
+ + 051  (defn- full-path +
+ + 052    [fp] +
+ + 053    (str +
+ + 054     (if (:filepath *options*) +
+ + 055       (str (:filepath *options*) (java.io.File/separator)) +
+ + 056       "") +
+ + 057     (if (and (string? fp) +
+ + 058              (> (count fp) 0) +
+ + 059              (not= fp "NIL")) +
+ + 060       fp +
+ + 061       (str "Sysout-" (local-date))) +
+ + 062     (if (ends-with? fp ".lsp") +
+ + 063       "" +
+ + 064       ".lsp"))) +
+ + 065   +
+ + 066  ;; (find-var (symbol "beowulf.io/SYSIN")) +
+ + 067  ;; (@(resolve (symbol "beowulf.host/TIMES")) 2 2) +
+ + 068   +
+ + 069  (defn safely-wrap-subr +
+ + 070    [entry] +
+ + 071    (cond (= entry NIL) NIL +
+ + 072          (= (CAR entry) 'SUBR) (make-cons-cell +
+ + 073                                 (CAR entry) +
+ + 074                                 (make-cons-cell +
+ + 075                                  (listify-qualified-name (CADR entry)) +
+ + 076                                  (CDDR entry))) +
+ + 077          :else (make-cons-cell +
+ + 078                 (CAR entry) (safely-wrap-subr (CDR entry))))) +
+ + 079   +
+ + 080  (defn safely-wrap-subrs +
+ + 081    [objects] +
+ + 082    (make-beowulf-list (map safely-wrap-subr objects))) +
+ + 083   +
+ + 084  (defn SYSOUT +
+ + 085    "Dump the current content of the object list to file. If no `filepath` is +
+ + 086     specified, a file name will be constructed of the symbol `Sysout` and  +
+ + 087     the current date. File paths will be considered relative to the filepath +
+ + 088     set when starting Lisp. +
+ + 089      +
+ + 090     **NOTE THAT** this is an extension function, not available in strct mode." +
+ + 091    ([] +
+ + 092     (SYSOUT nil)) +
+ + 093    ([filepath] +
+ + 094     (spit (full-path (str filepath)) +
+ + 095           (with-out-str +
+ + 096             (println (apply str (repeat 79 ";"))) +
+ + 097             (println (format ";; Beowulf %s Sysout file generated at %s" +
+ + 098                              (or (System/getProperty "beowulf.version") "") +
+ + 099                              (local-date-time))) +
+ + 100             (when (System/getenv "USER") +
+ + 101               (println (format ";; generated by %s" (System/getenv "USER")))) +
+ + 102             (println (apply str (repeat 79 ";"))) +
+ + 103             (println) +
+ + 104             (let [output (safely-wrap-subrs @oblist)] +
+ + 105               (pretty-print output) +
+ + 106               ))))) +
+ + 107   +
+ + 108  (defn resolve-subr +
+ + 109    "If this oblist `entry` references a subroutine, attempt to fix up that +
+ + 110     reference." +
+ + 111    ([entry] +
+ + 112     (or (resolve-subr entry 'SUBR) +
+ + 113         (resolve-subr entry 'FSUBR))) +
+ + 114    ([entry prop] +
+ + 115     (cond (= entry NIL) NIL +
+ + 116          (= (CAR entry) prop) (try +
+ + 117                                  (make-cons-cell +
+ + 118                                   (CAR entry) +
+ + 119                                   (make-cons-cell +
+ + 120                                    (interpret-qualified-name +
+ + 121                                           (CADR entry)) +
+ + 122                                    (CDDR entry))) +
+ + 123                                  (catch Exception _ +
+ + 124                                    (print "Warnung: ne can āfinde " +
+ + 125                                           (CADR entry)) +
+ + 126                                    (CDDR entry))) +
+ + 127          :else (make-cons-cell +
+ + 128                 (CAR entry) (resolve-subr (CDR entry)))))) +
+ + 129   +
+ + 130   +
+ + 131  (defn- resolve-subroutines +
+ + 132    "Attempt to fix up the references to subroutines (Clojure functions) among +
+ + 133     these `objects`, being new content for the object list." +
+ + 134    [objects] +
+ + 135    (make-beowulf-list +
+ + 136     (map +
+ + 137      resolve-subr +
+ + 138      objects))) +
+ + 139   +
+ + 140  (defn SYSIN +
+ + 141    "Read the contents of the file at this `filename` into the object list.  +
+ + 142      +
+ + 143     If the file is not a valid Beowulf sysout file, this will probably  +
+ + 144     corrupt the system, you have been warned. File paths will be considered  +
+ + 145     relative to the filepath set when starting Lisp. +
+ + 146   +
+ + 147     It is intended that sysout files can be read both from resources within +
+ + 148     the jar file, and from the file system. If a named file exists in both the +
+ + 149     file system and the resources, the file system will be preferred. +
+ + 150      +
+ + 151     **NOTE THAT** if the provided `filename` does not end with `.lsp` (which, +
+ + 152     if you're writing it from the Lisp REPL, it won't), the extension `.lsp` +
+ + 153     will be appended. +
+ + 154      +
+ + 155     **NOTE THAT** this is an extension function, not available in strct mode." +
+ + 156    ([] +
+ + 157     (SYSIN (or (:read *options*) (str "resources/" default-sysout)))) +
+ + 158    ([filename] +
+ + 159     (let [fp (file (full-path (str filename))) +
+ + 160           file (when (and (.exists fp) (.canRead fp)) fp) +
+ + 161           res (try (resource filename) +
+ + 162                    (catch Throwable _ nil)) +
+ + 163           content (try (READ (slurp (or file res))) +
+ + 164                        (catch Throwable _ +
+ + 165                          (throw (ex-info "Ne can ārǣde" +
+ + 166                                          {:context "SYSIN" +
+ + 167                                           :filename filename +
+ + 168                                           :filepath fp}))))] +
+ + 169       (swap! oblist +
+ + 170              #(when (or % (seq content)) +
+ + 171                 (resolve-subroutines content)))))) +
+ + diff --git a/docs/cloverage/beowulf/manual.clj.html b/docs/cloverage/beowulf/manual.clj.html new file mode 100644 index 0000000..b80738c --- /dev/null +++ b/docs/cloverage/beowulf/manual.clj.html @@ -0,0 +1,2315 @@ + + + + beowulf/manual.clj + + + + 001  (ns beowulf.manual +
+ + 002    "Experimental code for accessing the manual online." +
+ + 003    (:require [clojure.string :refer [ends-with? join trim]])) +
+ + 004   +
+ + 005  (def ^:dynamic *manual-url* +
+ + 006    "https://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf") +
+ + 007   +
+ + 008  (def ^:constant index +
+ + 009    "This is data extracted from the index pages of `Lisp 1.5 Programmer's Manual`. +
+ + 010     It's here in the hope that we can automatically link to an online PDF link +
+ + 011     to the manual when the user invokes a function probably called `DOC` or `HELP`." +
+ + 012    {:RECIP +
+ + 013     {:fn-name "RECIP", +
+ + 014      :call-type "SUBR", +
+ + 015      :implementation "", +
+ + 016      :page-nos ["26" "64"]}, +
+ + 017     :QUOTE +
+ + 018     {:fn-name "QUOTE", +
+ + 019      :call-type "FSUBR", +
+ + 020      :implementation "", +
+ + 021      :page-nos ["10" "22" "71"]}, +
+ + 022     :RECLAIM +
+ + 023     {:fn-name "RECLAIM", +
+ + 024      :call-type "SUBR", +
+ + 025      :implementation "PSEUDO-FUNCTION ", +
+ + 026      :page-nos ["67"]}, +
+ + 027     :NUMOB +
+ + 028     {:fn-name "NUMOB", +
+ + 029      :call-type "SUBR", +
+ + 030      :implementation "PSEUDO-FUNCTION ", +
+ + 031      :page-nos ["86"]}, +
+ + 032     :EVLIS +
+ + 033     {:fn-name "EVLIS", +
+ + 034      :call-type "SUBR", +
+ + 035      :implementation "", +
+ + 036      :page-nos ["71"]}, +
+ + 037     :DASH +
+ + 038     {:fn-name "DASH", +
+ + 039      :call-type "SUBR", +
+ + 040      :implementation "PREDICATE APVAL", +
+ + 041      :page-nos ["85" "87 "]}, +
+ + 042     :EQUAL +
+ + 043     {:fn-name "EQUAL", +
+ + 044      :call-type "SUBR", +
+ + 045      :implementation "PREDICATE", +
+ + 046      :page-nos ["11" "26" "57"]}, +
+ + 047     :PRIN1 +
+ + 048     {:fn-name "PRIN1", +
+ + 049      :call-type "SUBR", +
+ + 050      :implementation "PSEUDO-FUNCTION ", +
+ + 051      :page-nos ["65" "84"]}, +
+ + 052     :REMFLAG +
+ + 053     {:fn-name "REMFLAG", +
+ + 054      :call-type "SUBR", +
+ + 055      :implementation "PSEUDO-FUNCTION ", +
+ + 056      :page-nos ["41" "60"]}, +
+ + 057     :DEFINE +
+ + 058     {:fn-name "DEFINE", +
+ + 059      :call-type "EXPR", +
+ + 060      :implementation "PSEUDO-FUNCTION", +
+ + 061      :page-nos ["15" "18" "58"]}, +
+ + 062     :PUNCHLAP +
+ + 063     {:fn-name "PUNCHLAP", +
+ + 064      :call-type "EXPR", +
+ + 065      :implementation "PSEUDO-FUNCTION LIBRARY", +
+ + 066      :page-nos ["68" "76"]}, +
+ + 067     :STARTREAD +
+ + 068     {:fn-name "STARTREAD", +
+ + 069      :call-type "SUBR", +
+ + 070      :implementation "PSEUDO-FUNCTION", +
+ + 071      :page-nos ["87"]}, +
+ + 072     :PERIOD +
+ + 073     {:fn-name "PERIOD", +
+ + 074      :call-type "APVAL", +
+ + 075      :implementation "", +
+ + 076      :page-nos ["69" "85"]}, +
+ + 077     :CP1 +
+ + 078     {:fn-name "CP1", +
+ + 079      :call-type "SUBR", +
+ + 080      :implementation "", +
+ + 081      :page-nos ["66"]}, +
+ + 082     :NCONC +
+ + 083     {:fn-name "NCONC", +
+ + 084      :call-type "SUBR", +
+ + 085      :implementation "PSEUDO-FUNCTION ", +
+ + 086      :page-nos ["62"]}, +
+ + 087     :EQ +
+ + 088     {:fn-name "EQ", +
+ + 089      :call-type "SUBR", +
+ + 090      :implementation "PREDICATE", +
+ + 091      :page-nos ["3" "23" "57"]}, +
+ + 092     :RPLACD +
+ + 093     {:fn-name "RPLACD", +
+ + 094      :call-type "SUBR", +
+ + 095      :implementation "PSEUDO-FUNCTION", +
+ + 096      :page-nos ["41" "58"]}, +
+ + 097     :PROG2 +
+ + 098     {:fn-name "PROG2", +
+ + 099      :call-type "SUBR", +
+ + 100      :implementation "", +
+ + 101      :page-nos ["42" "66"]}, +
+ + 102     :UNCOUNT +
+ + 103     {:fn-name "UNCOUNT", +
+ + 104      :call-type "SUBR", +
+ + 105      :implementation "PSEUDO-FUNCTION", +
+ + 106      :page-nos ["34" "66"]}, +
+ + 107     :ERROR1 +
+ + 108     {:fn-name "ERROR1", +
+ + 109      :call-type "SUBR", +
+ + 110      :implementation "PSEUDO-FUNCTION", +
+ + 111      :page-nos ["88"]}, +
+ + 112     :EXPT +
+ + 113     {:fn-name "EXPT", +
+ + 114      :call-type "SUBR", +
+ + 115      :implementation "", +
+ + 116      :page-nos ["26" "64"]}, +
+ + 117     :NOT +
+ + 118     {:fn-name "NOT", +
+ + 119      :call-type "SUBR", +
+ + 120      :implementation "PREDICATE", +
+ + 121      :page-nos ["21" "23" "58"]}, +
+ + 122     :SLASH +
+ + 123     {:fn-name "SLASH", +
+ + 124      :call-type "APVAL", +
+ + 125      :implementation "", +
+ + 126      :page-nos ["69" "85"]}, +
+ + 127     :RPLACA +
+ + 128     {:fn-name "RPLACA", +
+ + 129      :call-type "SUBR", +
+ + 130      :implementation "PSEUDO-FUNCTION", +
+ + 131      :page-nos ["41" "58"]}, +
+ + 132     :QUOTIENT +
+ + 133     {:fn-name "QUOTIENT", +
+ + 134      :call-type "SUBR", +
+ + 135      :implementation "", +
+ + 136      :page-nos ["26" "64"]}, +
+ + 137     :UNPACK +
+ + 138     {:fn-name "UNPACK", +
+ + 139      :call-type "SUBR", +
+ + 140      :implementation "PSEUDO-FUNCTION", +
+ + 141      :page-nos ["87"]}, +
+ + 142     :CONC +
+ + 143     {:fn-name "CONC", +
+ + 144      :call-type "FEXPR", +
+ + 145      :implementation "", +
+ + 146      :page-nos ["61"]}, +
+ + 147     :CAR +
+ + 148     {:fn-name "CAR", +
+ + 149      :call-type "SUBR", +
+ + 150      :implementation "", +
+ + 151      :page-nos ["2" "56"]}, +
+ + 152     :GENSYM +
+ + 153     {:fn-name "GENSYM", +
+ + 154      :call-type "SUBR", +
+ + 155      :implementation "", +
+ + 156      :page-nos ["66"]}, +
+ + 157     :PROP +
+ + 158     {:fn-name "PROP", +
+ + 159      :call-type "SUBR", +
+ + 160      :implementation "FUNCTIONAL ", +
+ + 161      :page-nos [" 59"]}, +
+ + 162     :MEMBER +
+ + 163     {:fn-name "MEMBER", +
+ + 164      :call-type "SUBR", +
+ + 165      :implementation "PREDICATE ", +
+ + 166      :page-nos ["11" "62"]}, +
+ + 167     :UNTRACESET +
+ + 168     {:fn-name "UNTRACESET", +
+ + 169      :call-type "EXPR", +
+ + 170      :implementation "PSEUDO-FUNCTION", +
+ + 171      :page-nos ["68"]}, +
+ + 172     :UNTRACE +
+ + 173     {:fn-name "UNTRACE", +
+ + 174      :call-type "EXPR", +
+ + 175      :implementation "PSEUDO-FUNCTION", +
+ + 176      :page-nos ["32" "66"]}, +
+ + 177     :MINUSP +
+ + 178     {:fn-name "MINUSP", +
+ + 179      :call-type "SUBR", +
+ + 180      :implementation "PREDICATE ", +
+ + 181      :page-nos ["26" "64"]}, +
+ + 182     :F +
+ + 183     {:fn-name "F", +
+ + 184      :call-type "APVAL", +
+ + 185      :implementation "", +
+ + 186      :page-nos ["22" "69"]}, +
+ + 187     :SPECIAL +
+ + 188     {:fn-name "SPECIAL", +
+ + 189      :call-type "SUBR", +
+ + 190      :implementation "PSEUDO-FUNCTION", +
+ + 191      :page-nos ["64" "78"]}, +
+ + 192     :LPAR +
+ + 193     {:fn-name "LPAR", +
+ + 194      :call-type "APVAL", +
+ + 195      :implementation "", +
+ + 196      :page-nos ["69" "85"]}, +
+ + 197     :GO +
+ + 198     {:fn-name "GO", +
+ + 199      :call-type "FSUBR", +
+ + 200      :implementation "PSEUDO-FUNCTION", +
+ + 201      :page-nos ["30" "72"]}, +
+ + 202     :MKNAM +
+ + 203     {:fn-name "MKNAM", +
+ + 204      :call-type "SUBR", +
+ + 205      :implementation "", +
+ + 206      :page-nos ["86"]}, +
+ + 207     :COMMON +
+ + 208     {:fn-name "COMMON", +
+ + 209      :call-type "SUBR", +
+ + 210      :implementation "PSEUDO-FUNCTION", +
+ + 211      :page-nos ["64" "78"]}, +
+ + 212     :NUMBERP +
+ + 213     {:fn-name "NUMBERP", +
+ + 214      :call-type "SUBR", +
+ + 215      :implementation "PREDICATE ", +
+ + 216      :page-nos ["26" "64"]}, +
+ + 217     :CONS +
+ + 218     {:fn-name "CONS", +
+ + 219      :call-type "SUBR", +
+ + 220      :implementation "", +
+ + 221      :page-nos ["2" "56"]}, +
+ + 222     :PLUS +
+ + 223     {:fn-name "PLUS", +
+ + 224      :call-type "FSUBR", +
+ + 225      :implementation "", +
+ + 226      :page-nos ["25" "63"]}, +
+ + 227     :SET +
+ + 228     {:fn-name "SET", +
+ + 229      :call-type "SUBR", +
+ + 230      :implementation "PSEUDO-FUNCTION", +
+ + 231      :page-nos ["30" "71"]}, +
+ + 232     :DOLLAR +
+ + 233     {:fn-name "DOLLAR", +
+ + 234      :call-type "APVAL", +
+ + 235      :implementation "", +
+ + 236      :page-nos ["69" "85"]}, +
+ + 237     :SASSOC +
+ + 238     {:fn-name "SASSOC", +
+ + 239      :call-type "SUBR", +
+ + 240      :implementation "FUNCTIONAL", +
+ + 241      :page-nos ["60"]}, +
+ + 242     :SELECT +
+ + 243     {:fn-name "SELECT", +
+ + 244      :call-type "FEXPR", +
+ + 245      :implementation "", +
+ + 246      :page-nos ["66"]}, +
+ + 247     :OPDEFINE +
+ + 248     {:fn-name "OPDEFINE", +
+ + 249      :call-type "EXPR", +
+ + 250      :implementation "PSEUDO-FUNCTION ", +
+ + 251      :page-nos ["65" "75"]}, +
+ + 252     :PAUSE +
+ + 253     {:fn-name "PAUSE", +
+ + 254      :call-type "SUBR", +
+ + 255      :implementation "PSEUDO-FUNCTION", +
+ + 256      :page-nos ["67"]}, +
+ + 257     :AND +
+ + 258     {:fn-name "AND", +
+ + 259      :call-type "FSUBR", +
+ + 260      :implementation "PREDICATE", +
+ + 261      :page-nos ["21" "58"]}, +
+ + 262     :COMMA +
+ + 263     {:fn-name "COMMA", +
+ + 264      :call-type "APVAL", +
+ + 265      :implementation "", +
+ + 266      :page-nos ["69" "85"]}, +
+ + 267     :EFFACE +
+ + 268     {:fn-name "EFFACE", +
+ + 269      :call-type "SUBR", +
+ + 270      :implementation "PSEUDO-FUNCTION", +
+ + 271      :page-nos ["63"]}, +
+ + 272     :CSETQ +
+ + 273     {:fn-name "CSETQ", +
+ + 274      :call-type "FEXPR", +
+ + 275      :implementation "PSEUDO-FUNCTION", +
+ + 276      :page-nos ["59"]}, +
+ + 277     :OPCHAR +
+ + 278     {:fn-name "OPCHAR", +
+ + 279      :call-type "SUBR", +
+ + 280      :implementation "PREDICATE ", +
+ + 281      :page-nos [" 87"]}, +
+ + 282     :PRINTPROP +
+ + 283     {:fn-name "PRINTPROP", +
+ + 284      :call-type "EXPR", +
+ + 285      :implementation "PSEUDO-FUNCTION LIBRARY ", +
+ + 286      :page-nos ["68"]}, +
+ + 287     :PLB +
+ + 288     {:fn-name "PLB", +
+ + 289      :call-type "SUBR", +
+ + 290      :implementation "PSEUDO- FUNCTION", +
+ + 291      :page-nos ["67"]}, +
+ + 292     :DIGIT +
+ + 293     {:fn-name "DIGIT", +
+ + 294      :call-type "SUBR", +
+ + 295      :implementation "PREDICATE ", +
+ + 296      :page-nos ["87"]}, +
+ + 297     :PUNCHDEF +
+ + 298     {:fn-name "PUNCHDEF", +
+ + 299      :call-type "EXPR", +
+ + 300      :implementation "PSEUDO-FUNCTION LIBRARY", +
+ + 301      :page-nos ["68"]}, +
+ + 302     :ARRAY +
+ + 303     {:fn-name "ARRAY", +
+ + 304      :call-type "SUBR", +
+ + 305      :implementation "PSEUDO-FUNCTION", +
+ + 306      :page-nos ["27" "64"]}, +
+ + 307     :MAX +
+ + 308     {:fn-name "MAX", +
+ + 309      :call-type "FSUBR", +
+ + 310      :implementation "", +
+ + 311      :page-nos ["26" "64"]}, +
+ + 312     :INTERN +
+ + 313     {:fn-name "INTERN", +
+ + 314      :call-type "SUBR", +
+ + 315      :implementation "PSEUDO-FUNCTION", +
+ + 316      :page-nos ["67" "87"]}, +
+ + 317     :NIL +
+ + 318     {:fn-name "NIL", +
+ + 319      :call-type "APVAL", +
+ + 320      :implementation "", +
+ + 321      :page-nos ["22" "69"]}, +
+ + 322     :TIMES +
+ + 323     {:fn-name "TIMES", +
+ + 324      :call-type "FSUBR", +
+ + 325      :implementation "", +
+ + 326      :page-nos ["26" "64"]}, +
+ + 327     :ERROR +
+ + 328     {:fn-name "ERROR", +
+ + 329      :call-type "SUBR", +
+ + 330      :implementation "PSEUDO-FUNCTION", +
+ + 331      :page-nos ["32" "66"]}, +
+ + 332     :PUNCH +
+ + 333     {:fn-name "PUNCH", +
+ + 334      :call-type "SUBR", +
+ + 335      :implementation "PSEUDO-FUNCTION", +
+ + 336      :page-nos ["65" "84"]}, +
+ + 337     :REMPROP +
+ + 338     {:fn-name "REMPROP", +
+ + 339      :call-type "SUBR", +
+ + 340      :implementation "PSEUDO-FUNCTION", +
+ + 341      :page-nos ["41" "59"]}, +
+ + 342     :DIVIDE +
+ + 343     {:fn-name "DIVIDE", +
+ + 344      :call-type "SUBR", +
+ + 345      :implementation "", +
+ + 346      :page-nos ["26" "64"]}, +
+ + 347     :OR +
+ + 348     {:fn-name "OR", +
+ + 349      :call-type "FSUBR", +
+ + 350      :implementation "PREDICATE ", +
+ + 351      :page-nos ["21" "58"]}, +
+ + 352     :SUBLIS +
+ + 353     {:fn-name "SUBLIS", +
+ + 354      :call-type "SUBR", +
+ + 355      :implementation "", +
+ + 356      :page-nos ["12" "61"]}, +
+ + 357     :LAP +
+ + 358     {:fn-name "LAP", +
+ + 359      :call-type "SUBR", +
+ + 360      :implementation "PSEUDO-FUNCTION ", +
+ + 361      :page-nos ["65" "73"]}, +
+ + 362     :PROG +
+ + 363     {:fn-name "PROG", +
+ + 364      :call-type "FSUBR", +
+ + 365      :implementation "", +
+ + 366      :page-nos ["29" "71"]}, +
+ + 367     :T +
+ + 368     {:fn-name "T", +
+ + 369      :call-type "APVAL", +
+ + 370      :implementation "", +
+ + 371      :page-nos ["22" "69"]}, +
+ + 372     :GREATERP +
+ + 373     {:fn-name "GREATERP", +
+ + 374      :call-type "SUBR", +
+ + 375      :implementation "PREDICATE", +
+ + 376      :page-nos ["26" "64"]}, +
+ + 377     :CSET +
+ + 378     {:fn-name "CSET", +
+ + 379      :call-type "EXPR", +
+ + 380      :implementation "PSEUDO-FUNCTION", +
+ + 381      :page-nos ["17" "59"]}, +
+ + 382     :FUNCTION +
+ + 383     {:fn-name "FUNCTION", +
+ + 384      :call-type "FSUBR", +
+ + 385      :implementation "", +
+ + 386      :page-nos ["21" "71"]}, +
+ + 387     :LENGTH +
+ + 388     {:fn-name "LENGTH", +
+ + 389      :call-type "SUBR", +
+ + 390      :implementation "", +
+ + 391      :page-nos ["62"]}, +
+ + 392     :MINUS +
+ + 393     {:fn-name "MINUS", +
+ + 394      :call-type "SUBR", +
+ + 395      :implementation "", +
+ + 396      :page-nos ["26" "63"]}, +
+ + 397     :COND +
+ + 398     {:fn-name "COND", +
+ + 399      :call-type "FSUBR", +
+ + 400      :implementation "", +
+ + 401      :page-nos ["18"]}, +
+ + 402     :APPEND +
+ + 403     {:fn-name "APPEND", +
+ + 404      :call-type "SUBR", +
+ + 405      :implementation "", +
+ + 406      :page-nos ["11" "61"]}, +
+ + 407     :CDR +
+ + 408     {:fn-name "CDR", +
+ + 409      :call-type "SUBR", +
+ + 410      :implementation "", +
+ + 411      :page-nos ["3" "56"]}, +
+ + 412     :OBLIST +
+ + 413     {:fn-name "OBLIST", +
+ + 414      :call-type "APVAL", +
+ + 415      :implementation "", +
+ + 416      :page-nos ["69"]}, +
+ + 417     :READ +
+ + 418     {:fn-name "READ", +
+ + 419      :call-type "SUBR", +
+ + 420      :implementation "PSEUDO-FUNCTION ", +
+ + 421      :page-nos ["5" "84"]}, +
+ + 422     :ERRORSET +
+ + 423     {:fn-name "ERRORSET", +
+ + 424      :call-type "SUBR", +
+ + 425      :implementation "PSEUDO-FUNCTION", +
+ + 426      :page-nos ["35" "66"]}, +
+ + 427     :UNCOMMON +
+ + 428     {:fn-name "UNCOMMON", +
+ + 429      :call-type "SUBR", +
+ + 430      :implementation "PSEUDO-FUNCTION ", +
+ + 431      :page-nos ["64" "78"]}, +
+ + 432     :EVAL +
+ + 433     {:fn-name "EVAL", +
+ + 434      :call-type "SUBR", +
+ + 435      :implementation "", +
+ + 436      :page-nos ["71"]}, +
+ + 437     :MIN +
+ + 438     {:fn-name "MIN", +
+ + 439      :call-type "FSUBR", +
+ + 440      :implementation "", +
+ + 441      :page-nos ["26" "64"]}, +
+ + 442     :PAIR +
+ + 443     {:fn-name "PAIR", +
+ + 444      :call-type "SUBR", +
+ + 445      :implementation "", +
+ + 446      :page-nos ["60"]}, +
+ + 447     :BLANK +
+ + 448     {:fn-name "BLANK", +
+ + 449      :call-type "APVAL", +
+ + 450      :implementation "", +
+ + 451      :page-nos ["69" "85"]}, +
+ + 452     :SETQ +
+ + 453     {:fn-name "SETQ", +
+ + 454      :call-type "FSUBR", +
+ + 455      :implementation "PSEUDO-FUNCTION", +
+ + 456      :page-nos ["30" "71"]}, +
+ + 457     :GET +
+ + 458     {:fn-name "GET", +
+ + 459      :call-type "SUBR", +
+ + 460      :implementation "", +
+ + 461      :page-nos ["41" "59"]}, +
+ + 462     :PRINT +
+ + 463     {:fn-name "PRINT", +
+ + 464      :call-type "SUBR", +
+ + 465      :implementation "PSEUDO-FUNCTION ", +
+ + 466      :page-nos ["65" "84"]}, +
+ + 467     :ENDREAD +
+ + 468     {:fn-name "ENDREAD", +
+ + 469      :call-type "SUBR", +
+ + 470      :implementation "PSEUDO-FUNCTION", +
+ + 471      :page-nos ["8 8"]}, +
+ + 472     :RETURN +
+ + 473     {:fn-name "RETURN", +
+ + 474      :call-type "SUBR", +
+ + 475      :implementation "PSEUDO-FUNCTION", +
+ + 476      :page-nos ["30" "72"]}, +
+ + 477     :LITER +
+ + 478     {:fn-name "LITER", +
+ + 479      :call-type "SUBR", +
+ + 480      :implementation "PREDICATE ", +
+ + 481      :page-nos ["87"]}, +
+ + 482     :EOF +
+ + 483     {:fn-name "EOF", +
+ + 484      :call-type "APVAL", +
+ + 485      :implementation "", +
+ + 486      :page-nos ["69" "88"]}, +
+ + 487     :TRACE +
+ + 488     {:fn-name "TRACE", +
+ + 489      :call-type "EXPR", +
+ + 490      :implementation "PSEUDO-FUNCTION", +
+ + 491      :page-nos ["32" "66" "79"]}, +
+ + 492     :TRACESET +
+ + 493     {:fn-name "TRACESET", +
+ + 494      :call-type "EXPR", +
+ + 495      :implementation "PSEUDO-FUNCTION LIBRARY", +
+ + 496      :page-nos ["68"]}, +
+ + 497     :PACK +
+ + 498     {:fn-name "PACK", +
+ + 499      :call-type "SUBR", +
+ + 500      :implementation "PSEUDO-FUNCTION ", +
+ + 501      :page-nos ["86"]}, +
+ + 502     :NULL +
+ + 503     {:fn-name "NULL", +
+ + 504      :call-type "SUBR", +
+ + 505      :implementation "PREDICATE ", +
+ + 506      :page-nos ["11" "57"]}, +
+ + 507     :CLEARBUFF +
+ + 508     {:fn-name "CLEARBUFF", +
+ + 509      :call-type "SUBR", +
+ + 510      :implementation "PSEUDO-FUNCTION", +
+ + 511      :page-nos ["86"]}, +
+ + 512     :LESSP +
+ + 513     {:fn-name "LESSP", +
+ + 514      :call-type "SUBR", +
+ + 515      :implementation "PREDICATE ", +
+ + 516      :page-nos ["26" "64"]}, +
+ + 517     :TERPRI +
+ + 518     {:fn-name "TERPRI", +
+ + 519      :call-type "SUBR", +
+ + 520      :implementation "PSEUDO-FUNCTION", +
+ + 521      :page-nos ["65" "84"]}, +
+ + 522     :ONEP +
+ + 523     {:fn-name "ONEP", +
+ + 524      :call-type "SUBR", +
+ + 525      :implementation "PREDICATE ", +
+ + 526      :page-nos [" 26" "64"]}, +
+ + 527     :EXCISE +
+ + 528     {:fn-name "EXCISE", +
+ + 529      :call-type "SUBR", +
+ + 530      :implementation "PSEUDO-FUNCTION", +
+ + 531      :page-nos ["67" "77"]}, +
+ + 532     :REMOB +
+ + 533     {:fn-name "REMOB", +
+ + 534      :call-type "SUBR", +
+ + 535      :implementation "PSEUDO-FUNCTION ", +
+ + 536      :page-nos ["67"]}, +
+ + 537     :MAP +
+ + 538     {:fn-name "MAP", +
+ + 539      :call-type "SUBR", +
+ + 540      :implementation "FUNCTIONAL ", +
+ + 541      :page-nos ["63"]}, +
+ + 542     :COMPILE +
+ + 543     {:fn-name "COMPILE", +
+ + 544      :call-type "SUBR", +
+ + 545      :implementation "PSEUDO-FUNCTION", +
+ + 546      :page-nos ["64" "76"]}, +
+ + 547     :ADD1 +
+ + 548     {:fn-name "ADD1", +
+ + 549      :call-type "SUBR", +
+ + 550      :implementation "", +
+ + 551      :page-nos ["26" "64"]}, +
+ + 552     :ADVANCE +
+ + 553     {:fn-name "ADVANCE", +
+ + 554      :call-type "SUBR", +
+ + 555      :implementation "PSEUDO-FUNCTION", +
+ + 556      :page-nos ["88"]}, +
+ + 557     :SEARCH +
+ + 558     {:fn-name "SEARCH", +
+ + 559      :call-type "SUBR", +
+ + 560      :implementation "FUNCTIONAL", +
+ + 561      :page-nos ["63"]}, +
+ + 562     :APPLY +
+ + 563     {:fn-name "APPLY", +
+ + 564      :call-type "SUBR", +
+ + 565      :implementation "", +
+ + 566      :page-nos ["70"]}, +
+ + 567     :READLAP +
+ + 568     {:fn-name "READLAP", +
+ + 569      :call-type "SUBR", +
+ + 570      :implementation "PSEUDO-FUNCTION ", +
+ + 571      :page-nos ["65" "76"]}, +
+ + 572     :UNSPECIAL +
+ + 573     {:fn-name "UNSPECIAL", +
+ + 574      :call-type "SUBR", +
+ + 575      :implementation "", +
+ + 576      :page-nos ["64" "78"]}, +
+ + 577     :SUBST +
+ + 578     {:fn-name "SUBST", +
+ + 579      :call-type "SUBR", +
+ + 580      :implementation "", +
+ + 581      :page-nos ["11" "61"]}, +
+ + 582     :COPY +
+ + 583     {:fn-name "COPY", +
+ + 584      :call-type "SUBR", +
+ + 585      :implementation "", +
+ + 586      :page-nos ["62"]}, +
+ + 587     :LOGOR +
+ + 588     {:fn-name "LOGOR", +
+ + 589      :call-type "FSUBR", +
+ + 590      :implementation "", +
+ + 591      :page-nos ["26" "64"]}, +
+ + 592     :LABEL +
+ + 593     {:fn-name "LABEL", +
+ + 594      :call-type "FSUBR", +
+ + 595      :implementation "", +
+ + 596      :page-nos ["8" "18" "70"]}, +
+ + 597     :FIXP +
+ + 598     {:fn-name "FIXP", +
+ + 599      :call-type "SUBR", +
+ + 600      :implementation "PREDICATE", +
+ + 601      :page-nos ["26" "64"]}, +
+ + 602     :SUB1 +
+ + 603     {:fn-name "SUB1", +
+ + 604      :call-type "SUBR", +
+ + 605      :implementation "", +
+ + 606      :page-nos ["26" "64"]}, +
+ + 607     :ATTRIB +
+ + 608     {:fn-name "ATTRIB", +
+ + 609      :call-type "SUBR", +
+ + 610      :implementation "PSEUDO-FUNCTION", +
+ + 611      :page-nos ["59"]}, +
+ + 612     :DIFFERENCE +
+ + 613     {:fn-name "DIFFERENCE", +
+ + 614      :call-type "SUBR", +
+ + 615      :implementation "", +
+ + 616      :page-nos ["26" "64"]}, +
+ + 617     :REMAINDER +
+ + 618     {:fn-name "REMAINDER", +
+ + 619      :call-type "SUBR", +
+ + 620      :implementation "", +
+ + 621      :page-nos ["26" "64"]}, +
+ + 622     :REVERSE +
+ + 623     {:fn-name "REVERSE", +
+ + 624      :call-type "SUBR", +
+ + 625      :implementation "", +
+ + 626      :page-nos ["6 2"]}, +
+ + 627     :EOR +
+ + 628     {:fn-name "EOR", +
+ + 629      :call-type "APVAL", +
+ + 630      :implementation "", +
+ + 631      :page-nos ["69" "88"]}, +
+ + 632     :PLUSS +
+ + 633     {:fn-name "PLUSS", +
+ + 634      :call-type "APVAL", +
+ + 635      :implementation "", +
+ + 636      :page-nos ["69" "85"]}, +
+ + 637     :TEMPUS-FUGIT +
+ + 638     {:fn-name "TEMPUS-FUGIT", +
+ + 639      :call-type "SUBR", +
+ + 640      :implementation "PSEUDO-FUNCTION", +
+ + 641      :page-nos ["67"]}, +
+ + 642     :LOAD +
+ + 643     {:fn-name "LOAD", +
+ + 644      :call-type "SUBR", +
+ + 645      :implementation "PSEUDO-FUNCTION", +
+ + 646      :page-nos ["67"]}, +
+ + 647     :CHARCOUNT +
+ + 648     {:fn-name "CHARCOUNT", +
+ + 649      :call-type "APVAL", +
+ + 650      :implementation "", +
+ + 651      :page-nos ["69" "87"]}, +
+ + 652     :RPAR +
+ + 653     {:fn-name "RPAR", +
+ + 654      :call-type "APVAL", +
+ + 655      :implementation "", +
+ + 656      :page-nos ["69" "85"]}, +
+ + 657     :COUNT +
+ + 658     {:fn-name "COUNT", +
+ + 659      :call-type "SUBR", +
+ + 660      :implementation "PSEUDO-FUNCTION", +
+ + 661      :page-nos ["34" "66"]}, +
+ + 662     :SPEAK +
+ + 663     {:fn-name "SPEAK", +
+ + 664      :call-type "SUBR", +
+ + 665      :implementation "PSEUDO-FUNCTION", +
+ + 666      :page-nos ["34" "66 "]}, +
+ + 667     :LOGXOR +
+ + 668     {:fn-name "LOGXOR", +
+ + 669      :call-type "FSUBR", +
+ + 670      :implementation "", +
+ + 671      :page-nos ["27" "64"]}, +
+ + 672     :FLOATP +
+ + 673     {:fn-name "FLOATP", +
+ + 674      :call-type "SUBR", +
+ + 675      :implementation "PREDICATE", +
+ + 676      :page-nos ["26" "64"]}, +
+ + 677     :ATOM +
+ + 678     {:fn-name "ATOM", +
+ + 679      :call-type "SUBR", +
+ + 680      :implementation "PREDICATE", +
+ + 681      :page-nos ["3" "57"]}, +
+ + 682     :EQSIGN +
+ + 683     {:fn-name "EQSIGN", +
+ + 684      :call-type "APVAL", +
+ + 685      :implementation "", +
+ + 686      :page-nos ["69" "85"]}, +
+ + 687     :LIST +
+ + 688     {:fn-name "LIST", +
+ + 689      :call-type "FSUBR", +
+ + 690      :implementation "", +
+ + 691      :page-nos ["57"]}, +
+ + 692     :MAPLIST +
+ + 693     {:fn-name "MAPLIST", +
+ + 694      :call-type "SUBR", +
+ + 695      :implementation "FUNCTIONAL ", +
+ + 696      :page-nos ["20" "21" "63"]}, +
+ + 697     :LOGAND +
+ + 698     {:fn-name "LOGAND", +
+ + 699      :call-type "FSUBR", +
+ + 700      :implementation "", +
+ + 701      :page-nos ["27" "64"]}, +
+ + 702     :FLAG +
+ + 703     {:fn-name "FLAG", +
+ + 704      :call-type "EXPR", +
+ + 705      :implementation "PSEUDO-FUNCTION", +
+ + 706      :page-nos ["41" "60"]}, +
+ + 707     :MAPCON +
+ + 708     {:fn-name "MAPCON", +
+ + 709      :call-type "SUBR", +
+ + 710      :implementation "FUNCTIONAL PSEUDO- FUNCTION", +
+ + 711      :page-nos ["63"]}, +
+ + 712     :STAR +
+ + 713     {:fn-name "STAR", +
+ + 714      :call-type "APVAL", +
+ + 715      :implementation "", +
+ + 716      :page-nos ["69" "85"]}, +
+ + 717     :CURCHAR +
+ + 718     {:fn-name "CURCHAR", +
+ + 719      :call-type "APVAL", +
+ + 720      :implementation "", +
+ + 721      :page-nos ["69" "87"]}, +
+ + 722     :DUMP +
+ + 723     {:fn-name "DUMP", +
+ + 724      :call-type "SUBR", +
+ + 725      :implementation "PSEUDO-FUNCTION", +
+ + 726      :page-nos ["67"]}, +
+ + 727     :DEFLIST +
+ + 728     {:fn-name "DEFLIST", +
+ + 729      :call-type "EXPR", +
+ + 730      :implementation "PSEUDO-FUNCTION", +
+ + 731      :page-nos ["41" "58"]}, +
+ + 732     :LEFTSHIFT +
+ + 733     {:fn-name "LEFTSHIFT", +
+ + 734      :call-type "SUBR", +
+ + 735      :implementation "", +
+ + 736      :page-nos ["27" "64"]}, +
+ + 737     :ZEROP +
+ + 738     {:fn-name "ZEROP", +
+ + 739      :call-type "SUBR", +
+ + 740      :implementation "PREDICATE", +
+ + 741      :page-nos ["26" "64"]}}) +
+ + 742   +
+ + 743  (defn page-url +
+ + 744    "Format the URL for the page in the manual with this `page-no`." +
+ + 745    [page-no] +
+ + 746    (let [n (read-string page-no) +
+ + 747          n' (when (and (number? n) +
+ + 748                        (ends-with? *manual-url* ".pdf")) +
+ + 749               ;; annoyingly, the manual has eight pages of front-matter +
+ + 750               ;; before numbering starts. +
+ + 751               (+ n 8))] +
+ + 752      (format +
+ + 753       (if (ends-with? *manual-url* ".pdf") "%s#page=%s" "%s#page%s") +
+ + 754       *manual-url* +
+ + 755       (or n' (trim (str page-no)))))) +
+ + 756   +
+ + 757  (defn format-page-references +
+ + 758    "Format page references from the manual index for the function whose name +
+ + 759     is `fn-symbol`." +
+ + 760    [fn-symbol] +
+ + 761    (let [k (if (keyword? fn-symbol) fn-symbol (keyword fn-symbol))] +
+ + 762      (join ", " +
+ + 763            (doall +
+ + 764             (map +
+ + 765              (fn [n] +
+ + 766                (let [p (trim n)] +
+ + 767                  (format "<a href='%s'>%s</a>" +
+ + 768                          (page-url p) p))) +
+ + 769              (:page-nos (index k))))))) +
+ + diff --git a/docs/cloverage/beowulf/oblist.clj.html b/docs/cloverage/beowulf/oblist.clj.html new file mode 100644 index 0000000..f96cc9c --- /dev/null +++ b/docs/cloverage/beowulf/oblist.clj.html @@ -0,0 +1,143 @@ + + + + beowulf/oblist.clj + + + + 001  (ns beowulf.oblist +
+ + 002    "A namespace mainly devoted to the object list and other top level +
+ + 003     global variables. +
+ + 004      +
+ + 005     Yes, this makes little sense, but if you put them anywhere else you end +
+ + 006     up in cyclic dependency hell." +
+ + 007    ) +
+ + 008   +
+ + 009  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 010  ;;; +
+ + 011  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 012  ;;; +
+ + 013  ;;; This program is free software; you can redistribute it and/or +
+ + 014  ;;; modify it under the terms of the GNU General Public License +
+ + 015  ;;; as published by the Free Software Foundation; either version 2 +
+ + 016  ;;; of the License, or (at your option) any later version. +
+ + 017  ;;;  +
+ + 018  ;;; This program is distributed in the hope that it will be useful, +
+ + 019  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 020  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 021  ;;; GNU General Public License for more details. +
+ + 022  ;;;  +
+ + 023  ;;; You should have received a copy of the GNU General Public License +
+ + 024  ;;; along with this program; if not, write to the Free Software +
+ + 025  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 026  ;;; +
+ + 027  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 028   +
+ + 029  (def NIL +
+ + 030    "The canonical empty list symbol. +
+ + 031      +
+ + 032     TODO: this doesn't really work, because (from Clojure) `(empty? NIL)` throws +
+ + 033     an exception. It might be better to subclass beowulf.cons_cell.ConsCell to create +
+ + 034     a new singleton class Nil which overrides the `empty` method of  +
+ + 035     IPersistentCollection?" +
+ + 036    'NIL) +
+ + 037   +
+ + 038  (def oblist +
+ + 039    "The default environment." +
+ + 040    (atom NIL)) +
+ + 041   +
+ + 042  (def ^:dynamic *options* +
+ + 043    "Command line options from invocation." +
+ + 044    {}) +
+ + 045   +
+ + diff --git a/docs/cloverage/beowulf/read.clj.html b/docs/cloverage/beowulf/read.clj.html index f999f3a..ba3a47f 100644 --- a/docs/cloverage/beowulf/read.clj.html +++ b/docs/cloverage/beowulf/read.clj.html @@ -35,7 +35,7 @@ 010        reader ever did;
- 011    2. It treats everything between a semi-colon and an end of line as a comment, + 011    2. It treats everything between a double semi-colon and an end of line as a comment,
012        as most modern Lisps do; but I do not believe Lisp 1.5 had this feature. @@ -50,904 +50,283 @@ 015    switch."
- 016    (:require [beowulf.bootstrap :refer [*options*]] + 016    (:require ;; [beowulf.reader.char-reader :refer [read-chars]]
- 017              [clojure.math.numeric-tower :refer [expt]] + 017              [beowulf.reader.generate :refer [generate]]
- 018              [clojure.string :refer [starts-with? upper-case]] + 018              [beowulf.reader.parser :refer [parse]]
- 019              [instaparse.core :as i] + 019              [beowulf.reader.simplify :refer [simplify]]
- 020              [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]])) + 020              [clojure.string :refer [join split starts-with? trim]]) +
+ + 021    (:import [java.io InputStream] +
+ + 022             [instaparse.gll Failure]))
- 021   + 023  
- 022  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 024  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 023  ;;; + 025  ;;;
- 024  ;;; This file provides the reader required for boostrapping. It's not a bad + 026  ;;; This file provides the reader required for boostrapping. It's not a bad
- 025  ;;; reader - it provides feedback on errors found in the input - but it isn't + 027  ;;; reader - it provides feedback on errors found in the input - but it isn't
- 026  ;;; the real Lisp reader. + 028  ;;; the real Lisp reader.
- 027  ;;; + 029  ;;;
- 028  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 030  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 031  ;;; +
+ + 032  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 033  ;;; +
+ + 034  ;;; This program is free software; you can redistribute it and/or +
+ + 035  ;;; modify it under the terms of the GNU General Public License +
+ + 036  ;;; as published by the Free Software Foundation; either version 2 +
+ + 037  ;;; of the License, or (at your option) any later version. +
+ + 038  ;;;  +
+ + 039  ;;; This program is distributed in the hope that it will be useful, +
+ + 040  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 041  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 042  ;;; GNU General Public License for more details. +
+ + 043  ;;;  +
+ + 044  ;;; You should have received a copy of the GNU General Public License +
+ + 045  ;;; along with this program; if not, write to the Free Software +
+ + 046  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 047  ;;; +
+ + 048  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 029   -
- - 030  (declare generate) -
- - 031   + 049  
- 032  (def parse + 050  (defn strip-line-comments
- 033    "Parse a string presented as argument into a parse tree which can then + 051    "Strip blank lines and comment lines from this string `s`, expected to
- 034    be operated upon further." -
- - 035    (i/parser -
- - 036      (str + 052     be Lisp source."
- 037        ;; top level: we accept mexprs as well as sexprs. -
- - 038        "expr := mexpr | sexpr;" -
- - 039   -
- - 040        ;; mexprs. I'm pretty clear that Lisp 1.5 could never read these, -
- - 041        ;; but it's a convenience. -
- - 042        "mexpr := λexpr | fncall | defn | cond | mvar | mexpr comment; -
- - 043        λexpr := λ lsqb bindings semi-colon body rsqb; -
- - 044        λ := 'λ'; -
- - 045        bindings := lsqb args rsqb; -
- - 046        body := (expr semi-colon opt-space)* expr; -
- - 047        fncall := fn-name lsqb args rsqb; -
- - 048        lsqb := '['; -
- - 049        rsqb := ']'; -
- - 050        defn := mexpr opt-space '=' opt-space mexpr; -
- - 051        cond := lsqb (cond-clause semi-colon opt-space)* cond-clause rsqb; -
- - 052        cond-clause := expr opt-space arrow opt-space expr; -
- - 053        arrow := '->'; -
- - 054        args := (expr semi-colon opt-space)* expr; -
- - 055        fn-name := mvar; -
- - 056        mvar := #'[a-z]+'; -
- - 057        semi-colon := ';';" -
- - 058   -
- - 059        ;; comments. I'm pretty confident Lisp 1.5 did NOT have these. -
- - 060        "comment := opt-space <';;'> #'[^\\n\\r]*';" -
- - 061   -
- - 062        ;; sexprs. Note it's not clear to me whether Lisp 1.5 had the quote macro, -
- - 063        ;; but I've included it on the basis that it can do little harm. -
- - 064        "sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment; -
- - 065        list := lpar sexpr rpar | lpar (sexpr sep)* rpar | lpar (sexpr sep)* dot-terminal; -
- - 066        dotted-pair := lpar dot-terminal ; -
- - 067        dot := '.'; -
- - 068        lpar := '('; -
- - 069        rpar := ')'; -
- - 070        quoted-expr := quote sexpr; -
- - 071        quote := '\\''; -
- - 072        dot-terminal := sexpr space dot space sexpr rpar; -
- - 073        space := #'\\p{javaWhitespace}+'; -
- - 074        opt-space := #'\\p{javaWhitespace}*'; -
- - 075        sep := ',' | opt-space; -
- - 076        atom := #'[A-Z][A-Z0-9]*';" -
- - 077   -
- - 078        ;; Lisp 1.5 supported octal as well as decimal and scientific notation -
- - 079        "number := integer | decimal | scientific | octal; -
- - 080        integer := #'-?[1-9][0-9]*'; -
- - 081        decimal := #'-?[1-9][0-9]*\\.?[0-9]*' | #'0.[0-9]*'; -
- - 082        scientific := coefficient e exponent; -
- - 083        coefficient := decimal; -
- - 084        exponent := integer; -
- - 085        e := 'E'; -
- - 086        octal := #'[+-]?[0-7]+{1,12}' q scale-factor; -
- - 087        q := 'Q'; -
- - 088        scale-factor := #'[0-9]*'"))) -
- - 089   -
- - 090  (defn simplify -
- - 091    "Simplify this parse tree `p`. If `p` is an instaparse failure object, throw -
- - 092    an `ex-info`, with `p` as the value of its `:failure` key." -
- - 093    ([p] -
- - 094     (if -
- - 095       (instance? instaparse.gll.Failure p) -
- - 096       (throw (ex-info "Ic ne behæfd" {:cause :parse-failure :failure p})) -
- - 097       (simplify p :sexpr))) -
- - 098    ([p context] -
- - 099    (if + 053    [^String s]
- 100      (coll? p) -
- - 101      (apply -
- - 102        vector + 054    (join "\n"
- 103        (remove -
- - 104          #(if (coll? %) (empty? %)) -
- - 105          (case (first p) -
- - 106            (:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context) -
- - 107            (:λexpr -
- - 108              :args :bindings :body :cond :cond-clause :dot-terminal -
- - 109              :fncall :octal :quoted-expr :scientific) (map #(simplify % context) p) -
- - 110            (:arrow :dot :e :lpar :lsqb :opt-space :q :quote :rpar :rsqb -
- - 111              :semi-colon :sep :space) nil -
- - 112            :atom (if -
- - 113                    (= context :mexpr) -
- - 114                    [:quoted-expr p] -
- - 115                    p) -
- - 116            :comment (if -
- - 117                       (:strict *options*) -
- - 118                       (throw -
- - 119                         (ex-info "Cannot parse comments in strict mode" -
- - 120                                  {:cause :strict}))) -
- - 121            :dotted-pair (if -
- - 122                           (= context :mexpr) -
- - 123                           [:fncall -
- - 124                            [:mvar "cons"] -
- - 125                            [:args -
- - 126                             (simplify (nth p 1) context) -
- - 127                             (simplify (nth p 2) context)]] -
- - 128                           (map simplify p)) -
- - 129            :mexpr (if -
- - 130                     (:strict *options*) -
- - 131                     (throw -
- - 132                       (ex-info "Cannot parse meta expressions in strict mode" -
- - 133                                {:cause :strict})) -
- - 134                     (simplify (second p) :mexpr)) -
- - 135            :list (if -
- - 136                    (= context :mexpr) -
- - 137                    [:fncall -
- - 138                     [:mvar "list"] -
- - 139                     [:args (apply vector (map simplify (rest p)))]] -
- - 140                    (map #(simplify % context) p)) -
- - 141            ;;default -
- - 142            p))) -
- - 143      p))) -
- - 144   -
- - 145   -
- - 146  ;; # From Lisp 1.5 Programmers Manual, page 10 -
- - 147  ;; Note that I've retyped much of this, since copy/pasting out of PDF is less -
- - 148  ;; than reliable. Any typos are mine. Quote starts [[ -
- - 149   -
- - 150  ;; We are now in a position to define the universal LISP function -
- - 151  ;; evalquote[fn;args], When evalquote is given a function and a list of arguments -
- - 152  ;; for that function, it computes the value of the function applied to the arguments. -
- - 153  ;; LISP functions have S-expressions as arguments. In particular, the argument "fn" -
- - 154  ;; of the function evalquote must be an S-expression. Since we have been -
- - 155  ;; writing functions as M-expressions, it is necessary to translate them into -
- - 156  ;; S-expressions. -
- - 157   -
- - 158  ;; The following rules define a method of translating functions written in the -
- - 159  ;; meta-language into S-expressions. -
- - 160  ;; 1. If the function is represented by its name, it is translated by changing -
- - 161  ;;    all of the letters to upper case, making it an atomic symbol. Thus is -
- - 162  ;;    translated to CAR. -
- - 163  ;; 2. If the function uses the lambda notation, then the expression -
- - 164  ;;    λ[[x ..;xn]; ε] is translated into (LAMBDA (X1 ...XN) ε*), where ε* is the translation -
- - 165  ;;    of ε. -
- - 166  ;; 3. If the function begins with label, then the translation of -
- - 167  ;;    label[α;ε] is (LABEL α* ε*). -
- - 168   -
- - 169  ;; Forms are translated as follows: -
- - 170  ;; 1. A variable, like a function name, is translated by using uppercase letters. -
- - 171  ;;    Thus the translation of varl is VAR1. -
- - 172  ;; 2. The obvious translation of letting a constant translate into itself will not -
- - 173  ;;    work. Since the translation of x is X, the translation of X must be something -
- - 174  ;;    else to avoid ambiguity. The solution is to quote it. Thus X is translated -
- - 175  ;;    into (QUOTE X). -
- - 176  ;; 3. The form fn[argl;. ..;argn] is translated into (fn* argl* ...argn*) -
- - 177  ;; 4. The conditional expression [pl-el;...;pn-en] is translated into -
- - 178  ;;    (COND (p1* e1*)...(pn* en*)) -
- - 179   -
- - 180  ;; ## Examples -
- - 181   -
- - 182  ;; M-expressions                                S-expressions -
- - 183  ;; x                                            X -
- - 184  ;; car                                          CAR -
- - 185  ;; car[x]                                       (CAR X) -
- - 186  ;; T                                            (QUOTE T) -
- - 187  ;; ff[car [x]]                                  (FF (CAR X)) -
- - 188  ;; [atom[x]->x; T->ff[car[x]]]                  (COND ((ATOM X) X) -
- - 189  ;;                                                ((QUOTE T)(FF (CAR X)))) -
- - 190  ;; label[ff;λ[[x];[atom[x]->x; T->ff[car[x]]]]] (LABEL FF (LAMBDA (X) (COND -
- - 191  ;;                                                ((ATOM X) X) -
- - 192  ;;                                                ((QUOTE T)(FF (CAR X)))))) -
- - 193   -
- - 194  ;; ]] quote ends -
- - 195   -
- - 196  (defn gen-cond-clause -
- - 197    "Generate a cond clause from this simplified parse tree fragment `p`; -
- - 198    returns `nil` if `p` does not represent a cond clause." -
- - 199    [p] -
- - 200    (if -
- - 201      (and (coll? p)(= :cond-clause (first p))) -
- - 202      (make-beowulf-list -
- - 203        (list (generate (nth p 1)) -
- - 204                       (generate (nth p 2)))))) -
- - 205   -
- - 206  (defn gen-cond -
- - 207    "Generate a cond statement from this simplified parse tree fragment `p`; -
- - 208    returns `nil` if `p` does not represent a (MEXPR) cond statement." -
- - 209    [p] -
- - 210    (if -
- - 211      (and (coll? p)(= :cond (first p))) -
- - 212      (make-beowulf-list -
- - 213        (cons -
- - 214          'COND -
- - 215          (map -
- - 216            gen-cond-clause -
- - 217            (rest p)))))) -
- - 218   -
- - 219  (defn gen-fn-call -
- - 220    "Generate a function call from this simplified parse tree fragment `p`; -
- - 221    returns `nil` if `p` does not represent a (MEXPR) function call." -
- - 222    [p] -
- - 223    (if -
- - 224      (and (coll? p)(= :fncall (first p))(= :mvar (first (second p)))) -
- - 225      (make-cons-cell -
- - 226        (generate (second p)) -
- - 227        (generate (nth p 2))))) -
- - 228   -
- - 229   -
- - 230  (defn gen-dot-terminated-list -
- - 231    "Generate a list, which may be dot-terminated, from this partial parse tree -
- - 232    'p'. Note that the function acts recursively and progressively decapitates -
- - 233    its argument, so that the argument will not always be a valid parse tree." -
- - 234    [p] -
- - 235    (cond -
- - 236      (empty? p) -
- - 237      NIL -
- - 238      (and (coll? (first p)) (= :dot-terminal (first (first p)))) -
- - 239      (let [dt (first p)] -
- - 240        (make-cons-cell -
- - 241          (generate (nth dt 1)) -
- - 242          (generate (nth dt 2)))) -
- - 243      :else -
- - 244      (make-cons-cell -
- - 245        (generate (first p)) -
- - 246        (gen-dot-terminated-list (rest p))))) -
- - 247   -
- - 248   -
- - 249  (defn strip-leading-zeros -
- - 250    "`read-string` interprets strings with leading zeros as octal; strip -
- - 251    any from this string `s`. If what's left is empty (i.e. there were -
- - 252    only zeros, return `\"0\"`." -
- - 253    ([s] -
- - 254     (strip-leading-zeros s "")) -
- - 255    ([s prefix] -
- - 256     (if -
- - 257       (empty? s) "0" -
- - 258       (case (first s) -
- - 259         (\+ \-)(strip-leading-zeros (subs s 1) (str (first s) prefix)) -
- - 260         "0" (strip-leading-zeros (subs s 1) prefix) -
- - 261         (str prefix s))))) -
- - 262   -
- - 263  (defn generate -
- - 264    "Generate lisp structure from this parse tree `p`. It is assumed that -
- - 265    `p` has been simplified." -
- - 266    [p] -
- - 267    (if -
- - 268      (coll? p) -
- - 269      (case (first p) -
- - 270        :λ "LAMBDA" -
- - 271        :λexpr (make-cons-cell -
- - 272                 (generate (nth p 1)) -
- - 273                 (make-cons-cell (generate (nth p 2)) -
- - 274                                 (generate (nth p 3)))) -
- - 275        (:args :list) (gen-dot-terminated-list (rest p)) -
- - 276        :atom (symbol (second p)) -
- - 277        :bindings (generate (second p)) -
- - 278        :body (make-beowulf-list (map generate (rest p))) -
- - 279        :cond (gen-cond p) -
- - 280        (:decimal :integer) (read-string (strip-leading-zeros (second p))) -
- - 281        :dotted-pair (make-cons-cell -
- - 282                       (generate (nth p 1)) -
- - 283                       (generate (nth p 2))) -
- - 284        :exponent (generate (second p)) -
- - 285        :fncall (gen-fn-call p) -
- - 286        :mvar (symbol (upper-case (second p))) + 055          (remove
- 287        :octal (let [n (read-string (strip-leading-zeros (second p) "0")) + 056           #(or (empty? %)
- - 288                     scale (generate (nth p 2))] + + 057                (starts-with? (trim %) ";;"))
- - 289                 (* n (expt 8 scale))) + + 058           (split s #"\n"))))
- 290   + 059   +
+ + 060  (defn number-lines
- 291        ;; the quote read macro (which probably didn't exist in Lisp 1.5, but...) + 061    ([^String s]
- - 292        :quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p)))) + + 062     (number-lines s nil))
- - 293        :scale-factor (if + + 063    ([^String s ^Failure e] +
+ + 064     (let [l (-> e :line) +
+ + 065           c (-> e :column)] +
+ + 066       (join "\n" +
+ + 067             (map #(str (format "%5d %s" (inc %1) %2) +
+ + 068                        (when (= l (inc %1)) +
+ + 069                          (str "\n" (apply str (repeat c " ")) "^"))) +
+ + 070                  (range) +
+ + 071                  (split s #"\n")))))) +
+ + 072   +
+ + 073  (defn gsp +
+ + 074    "Shortcut macro - the internals of read; or, if you like, read-string. +
+ + 075    Argument `s` should be a string representation of a valid Lisp +
+ + 076    expression." +
+ + 077    [s] +
+ + 078    (let [source (strip-line-comments s) +
+ + 079          parse-tree (parse source)]
- 294                        (empty? (second p)) 0 -
- - 295                        (read-string (strip-leading-zeros (second p)))) -
- - 296        :scientific (let [n (generate (second p)) -
- - 297                          exponent (generate (nth p 2))] -
- - 298                      (* n (expt 10 exponent))) -
- - 299   -
- - 300        ;; default + 080      (if (instance? Failure parse-tree)
- 301        (throw (Exception. (str "Cannot yet generate " (first p))))) + 081        (doall (println (number-lines source parse-tree)) +
+ + 082               (throw (ex-info "Ne can forstande " (assoc parse-tree :source source)))) +
+ + 083        (generate (simplify parse-tree))))) +
+ + 084   +
+ + 085  (defn read-from-console +
+ + 086    "Attempt to read a complete lisp expression from the console. NOTE that this +
+ + 087     will only really work for S-Expressions, not M-Expressions." +
+ + 088    [] +
+ + 089    (loop [r (read-line)] +
+ + 090      (if (and (= (count (re-seq #"\(" r)) +
+ + 091             (count (re-seq #"\)" r))) +
+ + 092               (= (count (re-seq #"\[" r)) +
+ + 093                  (count (re-seq #"\]" r)))) +
+ + 094        r
- 302      p)) + 095        (recur (str r "\n" (read-line))))))
- 303   -
- - 304  (defmacro gsp -
- - 305    "Shortcut macro - the internals of read; or, if you like, read-string. -
- - 306    Argument `s` should be a string representation of a valid Lisp -
- - 307    expression." -
- - 308    [s] + 096  
- 309    `(generate (simplify (parse ~s)))) -
- - 310   -
- - 311  (defn READ + 097  (defn READ
- 312    "An implementation of a Lisp reader sufficient for bootstrapping; not necessarily + 098    "An implementation of a Lisp reader sufficient for bootstrapping; not necessarily
- 313    the final Lisp reader." + 099    the final Lisp reader. `input` should be either a string representation of a LISP
- 314    [input] + 100    expression, or else an input stream. A single form will be read."
- - 315    (gsp (or input (read-line)))) + + 101    ([] +
+ + 102     (gsp (read-from-console))) +
+ + 103    ([input] +
+ + 104     (cond +
+ + 105       (empty? input) (READ) +
+ + 106       (string? input) (gsp input) +
+ + 107       (instance? InputStream input) (READ (slurp input)) +
+ + 108       :else    (throw (ex-info "READ: `input` should be a string or an input stream" {})))))
diff --git a/docs/cloverage/beowulf/reader/char_reader.clj.html b/docs/cloverage/beowulf/reader/char_reader.clj.html new file mode 100644 index 0000000..f198c42 --- /dev/null +++ b/docs/cloverage/beowulf/reader/char_reader.clj.html @@ -0,0 +1,233 @@ + + + + beowulf/reader/char_reader.clj + + + + 001  (ns beowulf.reader.char-reader +
+ + 002    "Provide sensible line editing, auto completion, and history recall. +
+ + 003      +
+ + 004     None of what's needed here is really working yet, and a pull request with +
+ + 005     a working implementation would be greatly welcomed. +
+ + 006      +
+ + 007     ## What's needed (rough specification) +
+ + 008      +
+ + 009     1. Carriage return **does not** cause input to be returned, **unless** +
+ + 010         a. the number of open brackets `(` and closing brackets `)` match; and +
+ + 011         b. the number of open square brackets `[` and closing square brackets `]` also match; +
+ + 012     2. <Ctrl-D> aborts editing and returns the string `STOP`; +
+ + 013     3. <Up-arrow> and <down-arrow> scroll back and forward through history, but ideally I'd like  +
+ + 014        this to be the Lisp history (i.e. the history of S-Expressions actually read by `READ`,  +
+ + 015        rather than the strings which were supplied to `READ`); +
+ + 016     4. <Tab> offers potential auto-completions taken from the value of `(OBLIST)`, ideally the +
+ + 017        current value, not the value at the time the session started; +
+ + 018     5. <Back-arrow> and <Forward-arrow> offer movement and editing within the line. +
+ + 019      +
+ + 020     TODO: There are multiple problems with JLine; a better solution might be +
+ + 021     to start from here: +
+ + 022     https://stackoverflow.com/questions/7931988/how-to-manipulate-control-characters" +
+ + 023    ;; (:import [org.jline.reader LineReader LineReaderBuilder] +
+ + 024    ;;          [org.jline.terminal TerminalBuilder]) +
+ + 025    ) +
+ + 026   +
+ + 027  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 028  ;;; +
+ + 029  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 030  ;;; +
+ + 031  ;;; This program is free software; you can redistribute it and/or +
+ + 032  ;;; modify it under the terms of the GNU General Public License +
+ + 033  ;;; as published by the Free Software Foundation; either version 2 +
+ + 034  ;;; of the License, or (at your option) any later version. +
+ + 035  ;;;  +
+ + 036  ;;; This program is distributed in the hope that it will be useful, +
+ + 037  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 038  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 039  ;;; GNU General Public License for more details. +
+ + 040  ;;;  +
+ + 041  ;;; You should have received a copy of the GNU General Public License +
+ + 042  ;;; along with this program; if not, write to the Free Software +
+ + 043  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 044  ;;; +
+ + 045  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 046   +
+ + 047  ;; It looks from the example given [here](https://github.com/jline/jline3/blob/master/demo/src/main/java/org/jline/demo/Repl.java) +
+ + 048  ;; as though JLine could be used to build a perfect line-reader for Beowulf; but it also +
+ + 049  ;; looks as though you'd need a DPhil in JLine to write it, and I don't have +
+ + 050  ;; the time. +
+ + 051   +
+ + 052  ;; (def get-reader +
+ + 053  ;;   "Return a reader, first constructing it if necessary. +
+ + 054      +
+ + 055  ;;    **NOTE THAT** this is not settled API. The existence and call signature of +
+ + 056  ;;    this function is not guaranteed in future versions." +
+ + 057  ;;   (memoize (fn [] +
+ + 058  ;;   (let [term (.build (.system (TerminalBuilder/builder) true))] +
+ + 059  ;;     (.build (.terminal (LineReaderBuilder/builder) term)))))) +
+ + 060   +
+ + 061  ;; (defn read-chars +
+ + 062  ;;   "A drop-in replacement for `clojure.core/read-line`, except that line editing +
+ + 063  ;;    and history should be enabled. +
+ + 064      +
+ + 065  ;;    **NOTE THAT** this does not work yet, but it is in the API because I hope  +
+ + 066  ;;    that it will work later!" +
+ + 067  ;;   []  +
+ + 068  ;;     (let [eddie (get-reader)] +
+ + 069  ;;       (loop [s (.readLine eddie)] +
+ + 070  ;;       (if (and (= (count (re-seq #"\(" s)) +
+ + 071  ;;            (count (re-seq #"\)" s))) +
+ + 072  ;;                (= (count (re-seq #"\[]" s)) +
+ + 073  ;;                   (count (re-seq #"\]" s)))) +
+ + 074  ;;         s +
+ + 075  ;;         (recur (str s " " (.readLine eddie))))))) +
+ + diff --git a/docs/cloverage/beowulf/reader/generate.clj.html b/docs/cloverage/beowulf/reader/generate.clj.html new file mode 100644 index 0000000..a1be840 --- /dev/null +++ b/docs/cloverage/beowulf/reader/generate.clj.html @@ -0,0 +1,836 @@ + + + + beowulf/reader/generate.clj + + + + 001  (ns beowulf.reader.generate +
+ + 002    "Generating S-Expressions from parse trees.  +
+ + 003      +
+ + 004     ## From Lisp 1.5 Programmers Manual, page 10 +
+ + 005     *Note that I've retyped much of this, since copy/pasting out of PDF is less +
+ + 006     than reliable. Any typos are mine.* +
+ + 007      +
+ + 008     *Quote starts:* +
+ + 009   +
+ + 010     We are now in a position to define the universal LISP function +
+ + 011     `evalquote[fn;args]`, When evalquote is given a function and a list of arguments +
+ + 012     for that function, it computes the value of the function applied to the arguments. +
+ + 013     LISP functions have S-expressions as arguments. In particular, the argument `fn` +
+ + 014     of the function evalquote must be an S-expression. Since we have been +
+ + 015     writing functions as M-expressions, it is necessary to translate them into +
+ + 016     S-expressions. +
+ + 017   +
+ + 018     The following rules define a method of translating functions written in the +
+ + 019     meta-language into S-expressions. +
+ + 020     1. If the function is represented by its name, it is translated by changing +
+ + 021        all of the letters to upper case, making it an atomic symbol. Thus `car` is  +
+ + 022        translated to `CAR`. +
+ + 023     2. If the function uses the lambda notation, then the expression +
+ + 024        `λ[[x ..;xn]; ε]` is translated into `(LAMBDA (X1 ...XN) ε*)`, where ε* is the translation +
+ + 025        of ε. +
+ + 026     3. If the function begins with label, then the translation of +
+ + 027        `label[α;ε]` is `(LABEL α* ε*)`. +
+ + 028   +
+ + 029     Forms are translated as follows: +
+ + 030     1. A variable, like a function name, is translated by using uppercase letters. +
+ + 031        Thus the translation of `var1` is `VAR1`. +
+ + 032     2. The obvious translation of letting a constant translate into itself will not +
+ + 033        work. Since the translation of `x` is `X`, the translation of `X` must be something +
+ + 034        else to avoid ambiguity. The solution is to quote it. Thus `X` is translated +
+ + 035        into `(QUOTE X)`. +
+ + 036     3. The form `fn[argl;. ..;argn]` is translated into `(fn* argl* ...argn*)` +
+ + 037     4. The conditional expression `[pl-el;...;pn-en]` is translated into +
+ + 038        `(COND (p1* e1*)...(pn* en*))` +
+ + 039   +
+ + 040     ## Examples +
+ + 041     ``` +
+ + 042       M-expressions                                  S-expressions              +
+ + 043     +
+ + 044       x                                              X                          +
+ + 045       car                                            CAR                        +
+ + 046       car[x]                                         (CAR X)                    +
+ + 047       T                                              (QUOTE T)                  +
+ + 048       ff[car [x]]                                    (FF (CAR X))               +
+ + 049       [atom[x]->x; T->ff[car[x]]]                    (COND ((ATOM X) X)  +
+ + 050                                                          ((QUOTE T)(FF (CAR X)))) +
+ + 051       label[ff;λ[[x];[atom[x]->x;                    (LABEL FF (LAMBDA (X)  +
+ + 052            T->ff[car[x]]]]]                              (COND ((ATOM X) X)  +
+ + 053                                                              ((QUOTE T)(FF (CAR X)))))) +
+ + 054     ``` +
+ + 055   +
+ + 056     *quote ends* +
+ + 057  " +
+ + 058    (:require [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell]] +
+ + 059              [beowulf.reader.macros :refer [expand-macros]] +
+ + 060              [beowulf.oblist :refer [NIL]] +
+ + 061              [clojure.math.numeric-tower :refer [expt]] +
+ + 062              [clojure.string :refer [upper-case]] +
+ + 063              [clojure.tools.trace :refer [deftrace]])) +
+ + 064   +
+ + 065  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 066  ;;; +
+ + 067  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 068  ;;; +
+ + 069  ;;; This program is free software; you can redistribute it and/or +
+ + 070  ;;; modify it under the terms of the GNU General Public License +
+ + 071  ;;; as published by the Free Software Foundation; either version 2 +
+ + 072  ;;; of the License, or (at your option) any later version. +
+ + 073  ;;;  +
+ + 074  ;;; This program is distributed in the hope that it will be useful, +
+ + 075  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 076  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 077  ;;; GNU General Public License for more details. +
+ + 078  ;;;  +
+ + 079  ;;; You should have received a copy of the GNU General Public License +
+ + 080  ;;; along with this program; if not, write to the Free Software +
+ + 081  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 082  ;;; +
+ + 083  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 084   +
+ + 085  (declare generate) +
+ + 086   +
+ + 087  (defn gen-cond-clause +
+ + 088    "Generate a cond clause from this simplified parse tree fragment `p`; +
+ + 089    returns `nil` if `p` does not represent a cond clause." +
+ + 090    [p context] +
+ + 091    (when +
+ + 092     (and (coll? p) (= :cond-clause (first p))) +
+ + 093      (make-beowulf-list +
+ + 094       (list (if (= (nth p 1) [:quoted-expr [:atom "T"]]) +
+ + 095               'T +
+ + 096               (generate (nth p 1) context)) +
+ + 097             (generate (nth p 2) context))))) +
+ + 098   +
+ + 099  (defn gen-cond +
+ + 100    "Generate a cond statement from this simplified parse tree fragment `p`; +
+ + 101    returns `nil` if `p` does not represent a (MEXPR) cond statement." +
+ + 102    [p context] +
+ + 103    (when +
+ + 104     (and (coll? p) (= :cond (first p))) +
+ + 105      (make-beowulf-list +
+ + 106       (cons +
+ + 107        'COND +
+ + 108        (map +
+ + 109         #(generate % (if (= context :mexpr) :cond-mexpr context)) +
+ + 110         (rest p)))))) +
+ + 111   +
+ + 112  (defn gen-fn-call +
+ + 113    "Generate a function call from this simplified parse tree fragment `p`; +
+ + 114    returns `nil` if `p` does not represent a (MEXPR) function call." +
+ + 115    [p context] +
+ + 116    (when +
+ + 117     (and (coll? p) (= :fncall (first p)) (= :mvar (first (second p)))) +
+ + 118      (make-cons-cell +
+ + 119       (generate (second p) context) +
+ + 120       (generate (nth p 2) context)))) +
+ + 121   +
+ + 122   +
+ + 123  (defn gen-dot-terminated-list +
+ + 124    "Generate a list, which may be dot-terminated, from this partial parse tree +
+ + 125    'p'. Note that the function acts recursively and progressively decapitates +
+ + 126    its argument, so that the argument will not always be a valid parse tree." +
+ + 127    [p] +
+ + 128    (cond +
+ + 129      (empty? p) +
+ + 130      NIL +
+ + 131      (and (coll? (first p)) (= :dot-terminal (first (first p)))) +
+ + 132      (let [dt (first p)] +
+ + 133        (make-cons-cell +
+ + 134         (generate (nth dt 1)) +
+ + 135         (generate (nth dt 2)))) +
+ + 136      :else +
+ + 137      (make-cons-cell +
+ + 138       (generate (first p)) +
+ + 139       (gen-dot-terminated-list (rest p))))) +
+ + 140   +
+ + 141  ;; null[x] = [x = NIL -> T; T -> F] +
+ + 142  ;; [:defn  +
+ + 143  ;;  [:mexpr [:fncall [:mvar "null"] [:bindings [:args [:mexpr [:mvar "x"]]]]]]  +
+ + 144  ;;  "="  +
+ + 145  ;;  [:mexpr [:cond  +
+ + 146  ;;           [:cond-clause [:mexpr [:iexpr [:lhs [:mexpr [:mvar "x"]]] [:iop "="] [:rhs [:mexpr [:mconst "NIL"]]]]] [:mexpr [:mconst "T"]]]  +
+ + 147  ;;           [:cond-clause [:mexpr [:mconst "T"]] [:mexpr [:mconst "F"]]]]]] +
+ + 148   +
+ + 149  (defn generate-defn +
+ + 150    [tree context] +
+ + 151    (if (= :mexpr (first tree)) +
+ + 152      (generate-defn (second tree) context) +
+ + 153      (make-beowulf-list +
+ + 154       (list 'PUT +
+ + 155             (list 'QUOTE (generate (-> tree second second second) context)) +
+ + 156             (list 'QUOTE 'EXPR) +
+ + 157             (list 'QUOTE +
+ + 158                   (cons 'LAMBDA +
+ + 159                         (list (generate (nth (-> tree second second) 2) context) +
+ + 160                               (generate (nth tree 3) context)))))))) +
+ + 161   +
+ + 162  (defn gen-iexpr +
+ + 163    [tree context] +
+ + 164    (let [bundle (reduce #(assoc %1 (first %2) %2) +
+ + 165                         {} +
+ + 166                         (rest tree))] +
+ + 167      (list (generate (:iop bundle) context) +
+ + 168            (generate (:lhs bundle) context) +
+ + 169            (generate (:rhs bundle) context)))) +
+ + 170   +
+ + 171  (defn generate-set +
+ + 172    "Actually not sure what the mexpr representation of set looks like" +
+ + 173    [tree context] +
+ + 174    (throw (ex-info "Not Yet Implemented" {:feature "generate-set"}))) +
+ + 175   +
+ + 176  (defn generate-assign +
+ + 177    "Generate an assignment statement based on this `tree`. If the thing  +
+ + 178     being assigned to is a function signature, then we have to do something  +
+ + 179     different to if it's an atom." +
+ + 180    [tree context] +
+ + 181    (case (first (second tree)) +
+ + 182      :fncall (generate-defn tree context) +
+ + 183      :mexpr (map #(generate % context) (rest (second tree))) +
+ + 184      (:mvar :atom) (generate-set tree context))) +
+ + 185   +
+ + 186  (defn strip-leading-zeros +
+ + 187    "`read-string` interprets strings with leading zeros as octal; strip +
+ + 188    any from this string `s`. If what's left is empty (i.e. there were +
+ + 189    only zeros, return `\"0\"`." +
+ + 190    ([s] +
+ + 191     (strip-leading-zeros s "")) +
+ + 192    ([s prefix] +
+ + 193     (if +
+ + 194      (empty? s) "0" +
+ + 195      (case (first s) +
+ + 196        (\+ \-) (strip-leading-zeros (subs s 1) (str (first s) prefix)) +
+ + 197        "0" (strip-leading-zeros (subs s 1) prefix) +
+ + 198        (str prefix s))))) +
+ + 199   +
+ + 200  (defn generate +
+ + 201    "Generate lisp structure from this parse tree `p`. It is assumed that +
+ + 202    `p` has been simplified." +
+ + 203    ([p] +
+ + 204     (generate p :expr)) +
+ + 205    ([p context] +
+ + 206     (try +
+ + 207       (expand-macros +
+ + 208        (if +
+ + 209         (coll? p) +
+ + 210          (case (first p) +
+ + 211            :λ "LAMBDA" +
+ + 212            :λexpr (make-cons-cell +
+ + 213                    (generate (nth p 1) context) +
+ + 214                    (make-cons-cell (generate (nth p 2) context) +
+ + 215                                    (generate (nth p 3) context))) +
+ + 216            :args (make-beowulf-list (map #(generate % context) (rest p))) +
+ + 217            :atom (symbol (second p)) +
+ + 218            :bindings (generate (second p) context) +
+ + 219            :body (make-beowulf-list (map #(generate % context) (rest p))) +
+ + 220            (:coefficient :exponent) (generate (second p) context) +
+ + 221            :cond (gen-cond p (if (= context :mexpr) :cond-mexpr context)) +
+ + 222            :cond-clause (gen-cond-clause p context) +
+ + 223            :decimal (read-string (apply str (map second (rest p)))) +
+ + 224            :defn (generate-defn p context) +
+ + 225            :dotted-pair (make-cons-cell +
+ + 226                          (generate (nth p 1) context) +
+ + 227                          (generate (nth p 2) context)) +
+ + 228            :fncall (gen-fn-call p context) +
+ + 229            :iexpr (gen-iexpr p context) +
+ + 230            :integer (read-string (strip-leading-zeros (second p))) +
+ + 231            :iop (case (second p) +
+ + 232                   "/" 'DIFFERENCE +
+ + 233                   "=" 'EQUAL +
+ + 234                   ">" 'GREATERP +
+ + 235                   "<" 'LESSP +
+ + 236                   "+" 'PLUS +
+ + 237                   "*" 'TIMES +
+ + 238                  ;; else +
+ + 239                   (throw (ex-info "Unrecognised infix operator symbol" +
+ + 240                                   {:phase :generate +
+ + 241                                    :fragment p}))) +
+ + 242            :list (gen-dot-terminated-list (rest p)) +
+ + 243            (:lhs :rhs) (generate (second p) context) +
+ + 244            :mexpr (generate (second p) (if (= context :cond-mexpr) context :mexpr)) +
+ + 245            :mconst (if (= context :cond-mexpr) +
+ + 246                      (case (second p) +
+ + 247                        ("T" "F" "NIL") (symbol (second p)) +
+ + 248                        ;; else +
+ + 249                        (list 'QUOTE (symbol (second p)))) +
+ + 250                      ;; else +
+ + 251                      (list 'QUOTE (symbol (second p)))) +
+ + 252            :mvar (symbol (upper-case (second p))) +
+ + 253            :number (generate (second p) context) +
+ + 254            :octal (let [n (read-string (strip-leading-zeros (second p) "0")) +
+ + 255                         scale (generate (nth p 3) context)] +
+ + 256                     (* n (expt 8 scale))) +
+ + 257   +
+ + 258        ;; the quote read macro (which probably didn't exist in Lisp 1.5, but...) +
+ + 259            :quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p) context))) +
+ + 260            :scale-factor (if +
+ + 261                           (empty? (second p)) 0 +
+ + 262                           (read-string (strip-leading-zeros (second p)))) +
+ + 263            :scientific (let [n (generate (second p) context) +
+ + 264                              exponent (generate (nth p 3) context)] +
+ + 265                          (* n (expt 10 exponent))) +
+ + 266            :sexpr (generate (second p) :sexpr) +
+ + 267            :subr (symbol (second p)) +
+ + 268   +
+ + 269        ;; default +
+ + 270            (throw (ex-info (str "Unrecognised head: " (first p)) +
+ + 271                            {:generating p}))) +
+ + 272          p)) +
+ + 273       (catch Throwable any +
+ + 274         (throw (ex-info "Could not generate" +
+ + 275                         {:generating p} +
+ + 276                         any)))))) +
+ + diff --git a/docs/cloverage/beowulf/reader/macros.clj.html b/docs/cloverage/beowulf/reader/macros.clj.html new file mode 100644 index 0000000..8a44ffc --- /dev/null +++ b/docs/cloverage/beowulf/reader/macros.clj.html @@ -0,0 +1,212 @@ + + + + beowulf/reader/macros.clj + + + + 001  (ns beowulf.reader.macros +
+ + 002    "Can I implement reader macros? let's see! +
+ + 003      +
+ + 004     We don't need (at least, in the Clojure reader) to rewrite forms like +
+ + 005     `'FOO`, because that's handled by the parser. But we do need to rewrite +
+ + 006     things which don't evaluate their arguments, like `SETQ`, because (unless +
+ + 007     LABEL does it, which I'm not yet sure of) we're not yet able to implement +
+ + 008     things which don't evaluate arguments. +
+ + 009   +
+ + 010     TODO: at this stage, the following should probably also be read macros: +
+ + 011     DEFINE" +
+ + 012    (:require [beowulf.cons-cell :refer [make-beowulf-list]] +
+ + 013              [beowulf.host :refer [CONS LIST]] +
+ + 014              [clojure.string :refer [join]])) +
+ + 015   +
+ + 016  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 017  ;;; +
+ + 018  ;;; We don't need (at least, in the Clojure reader) to rewrite forms like +
+ + 019  ;;; "'FOO", because that's handled by the parser. But we do need to rewrite +
+ + 020  ;;; things which don't evaluate their arguments, like `SETQ`, because (unless +
+ + 021  ;;; LABEL does it, which I'm not yet sure of) we're not yet able to implement +
+ + 022  ;;; things which don't evaluate arguments. +
+ + 023  ;;; +
+ + 024  ;;; TODO: at this stage, the following should probably also be read macros: +
+ + 025  ;;; DEFINE +
+ + 026  ;;; +
+ + 027  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 028  ;;; +
+ + 029  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 030  ;;; +
+ + 031  ;;; This program is free software; you can redistribute it and/or +
+ + 032  ;;; modify it under the terms of the GNU General Public License +
+ + 033  ;;; as published by the Free Software Foundation; either version 2 +
+ + 034  ;;; of the License, or (at your option) any later version. +
+ + 035  ;;;  +
+ + 036  ;;; This program is distributed in the hope that it will be useful, +
+ + 037  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 038  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 039  ;;; GNU General Public License for more details. +
+ + 040  ;;;  +
+ + 041  ;;; You should have received a copy of the GNU General Public License +
+ + 042  ;;; along with this program; if not, write to the Free Software +
+ + 043  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 044  ;;; +
+ + 045  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 046   +
+ + 047  (def ^:dynamic *readmacros* +
+ + 048    {:car {'DEFUN (fn [f] +
+ + 049                    (LIST 'SET (LIST 'QUOTE (second f)) +
+ + 050                          (LIST 'QUOTE (CONS 'LAMBDA (rest (rest f)))))) +
+ + 051           'SETQ (fn [f] (LIST 'SET (LIST 'QUOTE (second f)) (nth f 2)))}}) +
+ + 052   +
+ + 053  (defn expand-macros +
+ + 054    [form] +
+ + 055    (try +
+ + 056      (if-let [car (when (and (coll? form) (symbol? (first form)))  +
+ + 057                     (first form))] +
+ + 058        (if-let [macro (-> *readmacros* :car car)] +
+ + 059          (make-beowulf-list (apply macro (list form))) +
+ + 060          form) +
+ + 061        form) +
+ + 062      (catch Exception any +
+ + 063        (println (join "\n" +
+ + 064                       ["# ERROR while expanding macro:" +
+ + 065                        (str "# Form: " form) +
+ + 066                        (str "# Error class: " (.getName (.getClass any))) +
+ + 067                        (str "# Message: " (.getMessage any))])) +
+ + 068        form))) +
+ + diff --git a/docs/cloverage/beowulf/reader/parser.clj.html b/docs/cloverage/beowulf/reader/parser.clj.html new file mode 100644 index 0000000..0e8427d --- /dev/null +++ b/docs/cloverage/beowulf/reader/parser.clj.html @@ -0,0 +1,368 @@ + + + + beowulf/reader/parser.clj + + + + 001  (ns beowulf.reader.parser +
+ + 002    "The actual parser, supporting both S-expression and M-expression syntax." +
+ + 003    (:require [instaparse.core :as i])) +
+ + 004   +
+ + 005  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 006  ;;; +
+ + 007  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 008  ;;; +
+ + 009  ;;; This program is free software; you can redistribute it and/or +
+ + 010  ;;; modify it under the terms of the GNU General Public License +
+ + 011  ;;; as published by the Free Software Foundation; either version 2 +
+ + 012  ;;; of the License, or (at your option) any later version. +
+ + 013  ;;;  +
+ + 014  ;;; This program is distributed in the hope that it will be useful, +
+ + 015  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 016  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 017  ;;; GNU General Public License for more details. +
+ + 018  ;;;  +
+ + 019  ;;; You should have received a copy of the GNU General Public License +
+ + 020  ;;; along with this program; if not, write to the Free Software +
+ + 021  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 022  ;;; +
+ + 023  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 024   +
+ + 025  (def parse +
+ + 026    "Parse a string presented as argument into a parse tree which can then +
+ + 027    be operated upon further." +
+ + 028    (i/parser +
+ + 029     (str +
+ + 030      ;; we tolerate whitespace and comments around legitimate input +
+ + 031      "raw := expr | opt-comment expr opt-comment;" +
+ + 032      ;; top level: we accept mexprs as well as sexprs. +
+ + 033      "expr := mexpr | sexpr ;" +
+ + 034   +
+ + 035      ;; comments. I'm pretty confident Lisp 1.5 did NOT have these. +
+ + 036      "comment := opt-space <';;'> opt-space #'[^\\n\\r]*';" +
+ + 037   +
+ + 038      ;; there's a notation comprising a left brace followed by mexprs +
+ + 039      ;; followed by a right brace which doesn't seem to be documented  +
+ + 040      ;; but I think must represent assembly code(?) +
+ + 041   +
+ + 042      ;; "assembly := lbrace exprs rbrace;" +
+ + 043   +
+ + 044      ;; mexprs. I'm pretty clear that Lisp 1.5 could never read these, +
+ + 045      ;; but it's a convenience. +
+ + 046   +
+ + 047      ;; TODO: this works for now but in fact the Programmer's Manual +
+ + 048      ;; gives a much simpler formulation of M-expression grammar on +
+ + 049      ;; page 9, and of the S-expression grammar on page 8. It would +
+ + 050      ;; be worth going back and redoing this from the book. +
+ + 051   +
+ + 052      "exprs := expr | exprs;" +
+ + 053      "mexpr := λexpr | fncall | defn | cond | mvar | mconst | iexpr | number | mexpr comment; +
+ + 054        λexpr := λ lsqb bindings semi-colon opt-space body opt-space rsqb; +
+ + 055        λ := 'λ' | 'lambda'; +
+ + 056        bindings := lsqb args rsqb | lsqb rsqb; +
+ + 057        body := (opt-space mexpr semi-colon)* opt-space mexpr; +
+ + 058        fncall := fn-name bindings; +
+ + 059        lsqb := '['; +
+ + 060        rsqb := ']'; +
+ + 061        lbrace := '{'; +
+ + 062        rbrace := '}'; +
+ + 063        defn := mexpr opt-space '=' opt-space mexpr; +
+ + 064        cond := lsqb (opt-space cond-clause semi-colon opt-space)* cond-clause rsqb; +
+ + 065        cond-clause := mexpr opt-space arrow opt-space mexpr opt-space; +
+ + 066        arrow := '->'; +
+ + 067        args := arg | (opt-space arg semi-colon opt-space)* opt-space arg opt-space; +
+ + 068        arg := mexpr; +
+ + 069        fn-name := mvar; +
+ + 070        mvar := #'[a-z][a-z0-9]*'; +
+ + 071        mconst := #'[A-Z][A-Z0-9]*'; +
+ + 072        semi-colon := ';';" +
+ + 073   +
+ + 074      ;; Infix operators appear in mexprs, e.g. on page 7. Ooops! +
+ + 075      ;; I do not know what infix operators are considered legal. +
+ + 076      ;; In particular I do not know what symbol was used for +
+ + 077      ;; multiply +
+ + 078      "iexpr := iexp iop iexp; +
+ + 079       iexp := mexpr | number | opt-space iexp opt-space; +
+ + 080      iop := '>' | '<' | '+' | '-' | '*' '/' | '=' ;" +
+ + 081   +
+ + 082      ;; comments. I'm pretty confident Lisp 1.5 did NOT have these. +
+ + 083      "opt-comment := opt-space | comment;" +
+ + 084      "comment := opt-space <';;'> #'[^\\n\\r]*' opt-space;" +
+ + 085   +
+ + 086      ;; sexprs. Note it's not clear to me whether Lisp 1.5 had the quote macro, +
+ + 087      ;; but I've included it on the basis that it can do little harm. +
+ + 088      "sexpr := quoted-expr | atom | number | subr | dotted-pair | list | sexpr comment; +
+ + 089        list := lpar sexpr rpar | lpar (sexpr sep)* rpar | lpar (sexpr sep)* dot-terminal | lbrace exprs rbrace; +
+ + 090        list := lpar opt-space sexpr rpar | lpar opt-space (sexpr sep)* rpar | lpar opt-space (sexpr sep)* dot-terminal; +
+ + 091        dotted-pair := lpar dot-terminal ; +
+ + 092        dot := '.'; +
+ + 093        lpar := '('; +
+ + 094        rpar := ')'; +
+ + 095        quoted-expr := quote sexpr; +
+ + 096        quote := '\\''; +
+ + 097        dot-terminal := sexpr space dot space sexpr rpar; +
+ + 098        space := #'\\p{javaWhitespace}+'; +
+ + 099        opt-space := #'\\p{javaWhitespace}*'; +
+ + 100        sep := ',' | opt-space; +
+ + 101        atom := #'[A-Z][A-Z0-9]*';" +
+ + 102   +
+ + 103      ;; we need a way of representing Clojure functions on the object list; +
+ + 104      ;; subr objects aren't expected to be normally entered on the REPL, but +
+ + 105      ;; must be on the object list or functions to which functions are passed +
+ + 106      ;; won't be able to access them. +
+ + 107      "subr := #'[a-z][a-z.]*/[A-Za-z][A-Za-z0-9]*';" +
+ + 108   +
+ + 109      ;; Lisp 1.5 supported octal as well as decimal and scientific notation +
+ + 110      "number := integer | decimal | scientific | octal; +
+ + 111        integer := #'-?[0-9]+'; +
+ + 112        decimal := integer dot integer; +
+ + 113        scientific := coefficient e exponent; +
+ + 114        coefficient := decimal | integer; +
+ + 115        exponent := integer; +
+ + 116        e := 'E'; +
+ + 117        octal := #'[+-]?[0-7]+{1,12}' q scale-factor; +
+ + 118        q := 'Q'; +
+ + 119        scale-factor := #'[0-9]*'"))) +
+ + 120   +
+ + diff --git a/docs/cloverage/beowulf/reader/simplify.clj.html b/docs/cloverage/beowulf/reader/simplify.clj.html new file mode 100644 index 0000000..8d50e4d --- /dev/null +++ b/docs/cloverage/beowulf/reader/simplify.clj.html @@ -0,0 +1,401 @@ + + + + beowulf/reader/simplify.clj + + + + 001  (ns beowulf.reader.simplify +
+ + 002    "Simplify parse trees. Be aware that this is very tightly coupled +
+ + 003     with the parser." +
+ + 004    (:require [beowulf.oblist :refer [*options*]] +
+ + 005              [instaparse.failure :as f]) +
+ + 006    (:import [instaparse.gll Failure])) +
+ + 007   +
+ + 008  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 009  ;;; +
+ + 010  ;;; Copyright (C) 2022-2023 Simon Brooke +
+ + 011  ;;; +
+ + 012  ;;; This program is free software; you can redistribute it and/or +
+ + 013  ;;; modify it under the terms of the GNU General Public License +
+ + 014  ;;; as published by the Free Software Foundation; either version 2 +
+ + 015  ;;; of the License, or (at your option) any later version. +
+ + 016  ;;;  +
+ + 017  ;;; This program is distributed in the hope that it will be useful, +
+ + 018  ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 019  ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 020  ;;; GNU General Public License for more details. +
+ + 021  ;;;  +
+ + 022  ;;; You should have received a copy of the GNU General Public License +
+ + 023  ;;; along with this program; if not, write to the Free Software +
+ + 024  ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. +
+ + 025  ;;; +
+ + 026  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 027   +
+ + 028  (declare simplify-tree) +
+ + 029   +
+ + 030  (defn remove-optional-space +
+ + 031    [tree] +
+ + 032    (if (vector? tree) +
+ + 033      (if (= :opt-space (first tree)) +
+ + 034        nil +
+ + 035        (let [v (remove nil? +
+ + 036                        (map remove-optional-space tree))] +
+ + 037          (if (seq v) +
+ + 038            (apply vector v) +
+ + 039            v))) +
+ + 040      tree)) +
+ + 041   +
+ + 042  (defn remove-nesting +
+ + 043    [tree context] +
+ + 044    (let [tree' (remove-optional-space tree)] +
+ + 045      (if-let [key (when (and (vector? tree')  +
+ + 046                              (keyword? (first tree')))  +
+ + 047                     (first tree'))] +
+ + 048        (loop [r tree'] +
+ + 049          (if (and r (vector? r) (keyword? (first r))) +
+ + 050            (if (= (first r) key) +
+ + 051              (recur (simplify-tree (second r) context)) +
+ + 052              r) +
+ + 053            r)) +
+ + 054        tree'))) +
+ + 055   +
+ + 056  (defn simplify-tree +
+ + 057    "Simplify this parse tree `p`. If `p` is an instaparse failure object, throw +
+ + 058     an `ex-info`, with `p` as the value of its `:failure` key. +
+ + 059      +
+ + 060     **NOTE THAT** it is assumed that `remove-optional-space` has been run on the +
+ + 061     parse tree **BEFORE** it is passed to `simplify-tree`." +
+ + 062    ([p] +
+ + 063     (if +
+ + 064      (instance? Failure p) +
+ + 065       (throw (ex-info +
+ + 066               (str "Ic ne behæfd: " (f/pprint-failure p)) +
+ + 067               {:cause :parse-failure +
+ + 068                :phase   :simplify +
+ + 069                :failure p})) +
+ + 070       (simplify-tree p :expr))) +
+ + 071    ([p context] +
+ + 072     (cond +
+ + 073       (string? p) p +
+ + 074       (coll? p) (apply +
+ + 075                  vector +
+ + 076                  (remove +
+ + 077                   #(when (coll? %) (empty? %)) +
+ + 078                   (case (first p) +
+ + 079                     (:λexpr +
+ + 080                      :args :bindings :body :cond :cond-clause :defn :dot-terminal  +
+ + 081                      :fncall :lhs :quoted-expr :rhs ) (map #(simplify-tree % context) p) +
+ + 082                     (:arg :expr :coefficient :fn-name :number) (simplify-tree (second p) context) +
+ + 083                     (:arrow :dot :e :lpar :lsqb  :opt-comment :opt-space :q :quote :rpar :rsqb +
+ + 084                             :semi-colon :sep :space) nil +
+ + 085                     :atom (if +
+ + 086                            (= context :mexpr) +
+ + 087                             [:quoted-expr p] +
+ + 088                             p) +
+ + 089                     :comment (when +
+ + 090                               (:strict *options*) +
+ + 091                                (throw +
+ + 092                                 (ex-info "Cannot parse comments in strict mode" +
+ + 093                                          {:cause :strict}))) +
+ + 094                     (:decimal :integer :mconst :octal :scientific) p +
+ + 095                     :dotted-pair (if +
+ + 096                                   (= context :mexpr) +
+ + 097                                    [:fncall +
+ + 098                                     [:mvar "cons"] +
+ + 099                                     [:args +
+ + 100                                      (simplify-tree (nth p 1) context) +
+ + 101                                      (simplify-tree (nth p 2) context)]] +
+ + 102                                    (map #(simplify-tree % context) p)) +
+ + 103                     :iexp (simplify-tree (second p) context) +
+ + 104                     :iexpr [:iexpr +
+ + 105                             [:lhs (simplify-tree (second p) context)] +
+ + 106                             (simplify-tree (nth p 2) context) ;; really should be the operator +
+ + 107                             [:rhs (simplify-tree (nth p 3) context)]] +
+ + 108                     :mexpr (if +
+ + 109                             (:strict *options*) +
+ + 110                              (throw +
+ + 111                               (ex-info "Cannot parse meta expressions in strict mode" +
+ + 112                                        {:cause :strict})) +
+ + 113                              [:mexpr (simplify-tree (second p) :mexpr)]) +
+ + 114                     :list (if +
+ + 115                            (= context :mexpr) +
+ + 116                             [:fncall +
+ + 117                              [:mvar "list"] +
+ + 118                              [:args (apply vector (map simplify-tree (rest p)))]] +
+ + 119                             (map #(simplify-tree % context) p)) +
+ + 120                     :raw (first (remove empty? (map simplify-tree (rest p)))) +
+ + 121                     :sexpr [:sexpr (simplify-tree (second p) :sexpr)] +
+ + 122            ;;default +
+ + 123                     p))) +
+ + 124       :else p))) +
+ + 125   +
+ + 126  (defn simplify +
+ + 127    "Simplify this parse tree `p`. If `p` is an instaparse failure object, throw +
+ + 128     an `ex-info`, with `p` as the value of its `:failure` key. Calls  +
+ + 129     `remove-optional-space` before processing." +
+ + 130    [p] +
+ + 131    (simplify-tree (remove-optional-space p))) +
+ + diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html index b064548..8f8236c 100644 --- a/docs/cloverage/index.html +++ b/docs/cloverage/index.html @@ -16,88 +16,225 @@ beowulf.bootstrap
759
496
-60.48 % + style="width:63.9344262295082%; + float:left;"> 624
352
+63.93 %
104
42
71
-67.28 % -41446217 + style="width:59.48275862068966%; + float:left;"> 138
19
75
+67.67 % +42233232 beowulf.cons-cell
129
98
-56.83 % + style="width:72.34927234927235%; + float:left;"> 348
133
+72.35 %
39
3
26
-61.76 % -1561568 + style="width:75.17241379310344%; + float:left;"> 109
9
27
+81.38 % +27423145 beowulf.core
170
17
-90.91 % + style="width:69.47368421052632%; + float:left;"> 198
87
+69.47 %
43
1
5
-89.80 % -80349 + style="width:72.46376811594203%; + float:left;"> 50
4
15
+78.26 % +132669 beowulf.host
1027
1374
+42.77 % +
137
37
81
+68.24 % +57166255 + + + beowulf.interop
142
104
+57.72 % +
31
6
29
+56.06 % +1291166 + + + beowulf.io
142
181
+43.96 % +
33
6
32
+54.93 % +1711271 + + + beowulf.manual
1721
73
+95.93 % +
298
17
+94.60 % +7694315 + + + beowulf.oblist
1
+ float:left;"> 9 100.00 %
1
+ float:left;"> 6 100.00 % -511 +4556 beowulf.read
588
130
-81.89 % + style="width:49.43181818181818%; + float:left;"> 87
89
+49.43 %
93
21
3
15
+61.54 % +108939 + + + beowulf.reader.char-reader
1
+100.00 % +
1
+100.00 % +7541 + + + beowulf.reader.generate
492
213
+69.79 % +
85
10
23
-81.75 % -31531126 + style="width:24.603174603174605%; + float:left;"> 31 +75.40 % +27621126 + + + beowulf.reader.macros
85
21
+80.19 % +
14
6
+70.00 % +68420 + + + beowulf.reader.parser
17
+100.00 % +
4
+100.00 % +120144 + + + beowulf.reader.simplify
255
190
+57.30 % +
40
3
38
+53.09 % +131681 Totals: -68.97 % +64.63 % -72.89 % +74.41 % diff --git a/docs/index.html b/docs/index.html deleted file mode 120000 index 2eb3014..0000000 --- a/docs/index.html +++ /dev/null @@ -1 +0,0 @@ -codox/intro.html \ No newline at end of file diff --git a/docs/index.html b/docs/index.html new file mode 100644 index 0000000..e54cf99 --- /dev/null +++ b/docs/index.html @@ -0,0 +1,14 @@ + + + + Beowulf: Documentation + + + +

Beowulf: Documentation

+ + +