From 71fa15462dc5ce5ecf893279ef732fdae1b90515 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 10 Apr 2023 15:39:04 +0100 Subject: [PATCH] Sorted out documentation problem for website. --- docs/cloverage/beowulf/bootstrap.clj.html | 2274 ++++++++-------- docs/cloverage/beowulf/cons_cell.clj.html | 1178 ++++++--- docs/cloverage/beowulf/core.clj.html | 490 ++-- docs/cloverage/beowulf/host.clj.html | 1702 +++++++++++- docs/cloverage/beowulf/interop.clj.html | 395 +++ docs/cloverage/beowulf/io.clj.html | 521 ++++ docs/cloverage/beowulf/manual.clj.html | 2315 +++++++++++++++++ docs/cloverage/beowulf/oblist.clj.html | 143 + docs/cloverage/beowulf/read.clj.html | 1047 ++------ .../beowulf/reader/char_reader.clj.html | 233 ++ .../beowulf/reader/generate.clj.html | 836 ++++++ docs/cloverage/beowulf/reader/macros.clj.html | 212 ++ docs/cloverage/beowulf/reader/parser.clj.html | 368 +++ .../beowulf/reader/simplify.clj.html | 401 +++ docs/cloverage/index.html | 247 +- docs/index.html | 15 +- 16 files changed, 9781 insertions(+), 2596 deletions(-) create mode 100644 docs/cloverage/beowulf/interop.clj.html create mode 100644 docs/cloverage/beowulf/io.clj.html create mode 100644 docs/cloverage/beowulf/manual.clj.html create mode 100644 docs/cloverage/beowulf/oblist.clj.html create mode 100644 docs/cloverage/beowulf/reader/char_reader.clj.html create mode 100644 docs/cloverage/beowulf/reader/generate.clj.html create mode 100644 docs/cloverage/beowulf/reader/macros.clj.html create mode 100644 docs/cloverage/beowulf/reader/parser.clj.html create mode 100644 docs/cloverage/beowulf/reader/simplify.clj.html mode change 120000 => 100644 docs/index.html 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

+ + +