Upversioned to 0.3 as much refactoring has changed API

project.clj

@@ -1,13 +1,13 @@
-(defproject beowulf "0.2.2-SNAPSHOT"
+(defproject beowulf "0.3.0-SNAPSHOT"
   :cloverage {:output "docs/cloverage"
-              :ns-exclude-regex [#"beowulf\.gendoc"]}
+              :ns-exclude-regex [#"beowulf\.gendoc" #"beowulf\.scratch"]}
   :codox {:metadata {:doc "**TODO**: write docs"
                      :doc/format :markdown}
           :output-path "docs/codox"
           :source-uri "https://github.com/simon-brooke/beowulf/blob/master/{filepath}#L{line}"}
   :description "An implementation of LISP 1.5 in Clojure"
   :license {:name "GPL-2.0-or-later"
-            :url "https://www.eclipse.org/legal/epl-2.0/"}
+            :url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
   :dependencies [[org.clojure/clojure "1.11.1"]
                  [org.clojure/math.numeric-tower "0.0.5"]
                  [org.clojure/tools.cli "1.0.214"]

resources/lisp1.5.lsp

@@ -1,5 +1,5 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Beowulf  Sysout file generated at 2023-03-30T09:40:36.483
+;; Beowulf  Sysout file generated at 2023-03-31T02:24:08.808
 ;; generated by simon
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -8,72 +8,84 @@
   (F)
   (ADD1)
   (AND)
-  (APPEND)
+  (APPEND LAMBDA
+    (X Y) (COND ((NULL X) Y) ((QUOTE T) (CONS (CAR X) (APPEND (CDR X) Y)))))
   (APPLY)
   (ATOM)
   (CAR)
   (CDR)
   (CONS)
-  (COPY LAMBDA (X) 
+  (COPY
-    (COND ((NULL X) (QUOTE NIL)) 
+    LAMBDA
-      ((ATOM X) X) 
+    (X)
-      ((QUOTE T) (CONS (COPY (CAR X)) (COPY (CDR X))))))
+    (COND
+      ((NULL X) (QUOTE NIL))
+      ((ATOM X) X) ((QUOTE T) (CONS (COPY (CAR X)) (COPY (CDR X))))))
   (DEFINE)
   (DIFFERENCE)
-  (DIVIDE LAMBDA (X Y) (CONS (QUOTIENT X Y) (CONS (REMAINDER X Y) (QUOTE NIL))))
+  (DIVIDE
+    LAMBDA (X Y) (CONS (QUOTIENT X Y) (CONS (REMAINDER X Y) (QUOTE NIL))))
   (ERROR)
   (EQ)
   (EQUAL)
   (EVAL)
+  (FACTORIAL
+    LAMBDA (N) (COND ((EQ N 1) 1) (T (TIMES N (FACTORIAL (SUB1 N))))))
   (FIXP)
   (GENSYM)
-  (GET LAMBDA (X Y) 
+  (GET
-    (COND ((NULL X) (QUOTE NIL)) 
+    LAMBDA
-      ((EQ (CAR X) Y) (CAR (CDR X))) 
+    (X Y)
-      ((QUOTE T) (GET (CDR X) Y))))
+    (COND
+      ((NULL X) (QUOTE NIL))
+      ((EQ (CAR X) Y) (CAR (CDR X))) ((QUOTE T) (GET (CDR X) Y))))
   (GREATERP)
   (INTEROP)
-  (INTERSECTION LAMBDA (X Y) 
+  (INTERSECTION
-    (COND ((NULL X) (QUOTE NIL)) 
+    LAMBDA
+    (X Y)
+    (COND
+      ((NULL X) (QUOTE NIL))
       ((MEMBER (CAR X) Y) (CONS (CAR X) (INTERSECTION (CDR X) Y)))
       ((QUOTE T) (INTERSECTION (CDR X) Y))))
   (LENGTH LAMBDA (L) (COND ((EQ NIL L) 0) (T (ADD1 (LENGTH (CDR L))))))
   (LESSP)
-  (MEMBER LAMBDA (A X) 
+  (MEMBER
-    (COND ((NULL X) (QUOTE F)) 
+    LAMBDA
-        ((EQ A (CAR X)) (QUOTE T)) 
+    (A X)
-        ((QUOTE T) (MEMBER A (CDR X)))))
+    (COND
+      ((NULL X) (QUOTE F))
+      ((EQ A (CAR X)) (QUOTE T)) ((QUOTE T) (MEMBER A (CDR X)))))
   (MINUSP LAMBDA (X) (LESSP X 0))
+  (NOT LAMBDA (X) (COND (X (QUOTE NIL)) ((QUOTE T) (QUOTE T))))
   (NULL LAMBDA (X) (COND ((EQUAL X NIL) (QUOTE T)) (T (QUOTE F))))
   (NUMBERP)
   (OBLIST)
   (ONEP LAMBDA (X) (EQ X 1))
-  (PAIR LAMBDA (X Y) 
+  (PAIR
-    (COND ((AND (NULL X) (NULL Y)) NIL)
+    LAMBDA
-        ((NULL X) (ERROR 'F2))
+    (X Y)
-        ((NULL Y) (ERROR 'F3))
+    (COND
+      ((AND (NULL X) (NULL Y)) NIL)
+      ((NULL X) (ERROR (QUOTE F2)))
+      ((NULL Y) (ERROR (QUOTE F3)))
       (T (CONS (CONS (CAR X) (CAR Y)) (PAIR (CDR X) (CDR Y))))))
   (PLUS)
   (PRETTY)
   (PRINT)
-  (PROP LAMBDA (X Y U) 
+  (PROP
-    (COND ((NULL X) (U)) 
+    LAMBDA
-      ((EQ (CAR X) Y) (CDR X)) 
+    (X Y U)
-      ((QUOTE T) (PROP (CDR X) Y U))))
+    (COND
+      ((NULL X) (U)) ((EQ (CAR X) Y) (CDR X)) ((QUOTE T) (PROP (CDR X) Y U))))
   (QUOTIENT)
   (READ)
   (REMAINDER)
-  (REPEAT LAMBDA (N X)
+  (REPEAT
-    (COND ((EQ N 0) NIL)
+    LAMBDA (N X) (COND ((EQ N 0) NIL) (T (CONS X (REPEAT (SUB1 N) X)))))
-        (T (CONS X (REPEAT (SUB1 N) X)))))
   (RPLACA)
   (RPLACD)
   (SET)
   (SUB1 LAMBDA (N) (DIFFERENCE N 1))
   (SYSIN)
-  (SYSOUT) 
+  (SYSOUT) (TERPRI) (TIMES) (TRACE) (UNTRACE) (ZEROP LAMBDA (N) (EQ N 0)))
-  (TERPRI)
-  (TIMES)
-  (TRACE)
-  (UNTRACE)
-  (ZEROP LAMBDA (N) (EQ N 0)))

resources/mexpr/append.mexpr.lsp

@@ -0,0 +1,3 @@
+;; page 61
+
+append[x; y] = [null[x] -> y; T -> cons[car[x]; append[cdr[x]; y]]]

src/beowulf/bootstrap.clj

@@ -10,63 +10,45 @@
   therefore all arguments must be numbers, symbols or `beowulf.cons_cell.ConsCell`
   objects."
   (:require [clojure.string :as s]
-            [beowulf.cons-cell :refer [CAR CDR CONS LIST make-beowulf-list make-cons-cell
+            [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell
                                        pretty-print T F]]
-            [beowulf.host :refer [AND ADD1 DIFFERENCE ERROR FIXP GENSYM GREATERP LESSP
+            [beowulf.host :refer [ADD1 AND ASSOC ATOM ATOM? CAR CDR CONS DEFINE 
-                                  NUMBERP PLUS QUOTIENT
+                                  DIFFERENCE EQ EQUAL ERROR FIXP GENSYM 
-                                  REMAINDER RPLACA RPLACD TIMES]]
+                                  GREATERP lax? LESSP LIST NUMBERP OBLIST
+                                  PAIRLIS PLUS QUOTIENT REMAINDER RPLACA RPLACD SET 
+                                  TIMES TRACE traced? UNTRACE]]
             [beowulf.io :refer [SYSIN SYSOUT]]
             [beowulf.oblist :refer [*options* oblist NIL]]
-            [beowulf.read :refer [READ]]
+            [beowulf.read :refer [READ]])
-            [beowulf.trace :refer [TRACE traced? UNTRACE]])
   (:import [beowulf.cons_cell ConsCell]
            [clojure.lang Symbol]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
-;;; This file is essentially Lisp as defined in Chapter 1 (pages 1-14) of the
+;;; Copyright (C) 2022-2023 Simon Brooke
-;;; Lisp 1.5 Programmer's Manual; that is to say, a very simple Lisp language,
+;;;
-;;; which should, I believe, be sufficient in conjunction with the functions
+;;; This program is free software; you can redistribute it and/or
-;;; provided by `beowulf.host`, be sufficient to bootstrap the full Lisp 1.5
+;;; modify it under the terms of the GNU General Public License
-;;; interpreter.
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (declare APPLY EVAL)
 
-(defn lax?
+(defmacro QUOTE
-  "Are we in lax mode? If so. return true; is not, throw an exception with 
+  "Quote, but in upper case for LISP 1.5"
-   this `symbol`."
+  [f]
-  [symbol]
+  `(quote ~f))
-  (when (:strict *options*)
-    (throw (ex-info (format "%s is not available in Lisp 1.5" symbol)
-                    {:cause :strict
-                     :extension symbol})))
-  true)
-
-(defmacro NULL
-  "Returns `T` if and only if the argument `x` is bound to `NIL`; else `F`."
-  [x]
-  `(if (= ~x NIL) T F))
-
-(defmacro NILP
-  "Not part of LISP 1.5: `T` if `o` is `NIL`, else `NIL`."
-  [x]
-  `(if (= ~x NIL) T NIL))
-
-(defmacro ATOM
-  "Returns `T` if and only if the argument `x` is bound to an atom; else `F`.
-  It is not clear to me from the documentation whether `(ATOM 7)` should return
-  `T` or `F`. I'm going to assume `T`."
-  [x]
-  `(if (or (symbol? ~x) (number? ~x)) T F))
-
-(defmacro ATOM?
-  "The convention of returning `F` from predicates, rather than `NIL`, is going
-  to tie me in knots. This is a variant of `ATOM` which returns `NIL`
-  on failure."
-  [x]
-  `(if (or (symbol? ~x) (number? ~x)) T NIL))
 
 (defn uaf
   "Universal access function; `l` is expected to be an arbitrary LISP list, `path`
@@ -123,127 +105,7 @@
 (defmacro CDAADR [x] `(uaf ~x '(\d \a \a \d)))
 (defmacro CDADDR [x] `(uaf ~x '(\d \a \d \d)))
 
-(defn EQ
+;;;; INTEROP feature ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  "Returns `T` if and only if both `x` and `y` are bound to the same atom,
-  else `NIL`."
-  [x y]
-  (cond (and (instance? ConsCell x)
-             (.equals x y)) T
-        (and (= (ATOM x) T) (= x y)) T
-        :else NIL))
-
-(defn EQUAL
-  "This is a predicate that is true if its two arguments are identical
-  S-expressions, and false if they are different. (The elementary predicate
-  `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is
-  an example of a conditional expression inside a conditional expression.
-
-  NOTE: returns `F` on failure, not `NIL`"
-  [x y]
-  (cond
-    (= (ATOM x) T) (if (= x y) T F)
-    (= (EQUAL (CAR x) (CAR y)) T) (EQUAL (CDR x) (CDR y))
-    :else F))
-
-(defn SUBST
-  "This function gives the result of substituting the S-expression `x` for
-  all occurrences of the atomic symbol `y` in the S-expression `z`."
-  [x y z]
-  (cond
-    (= (EQUAL y z) T) x
-    (= (ATOM? z) T) z ;; NIL is a symbol
-    :else
-    (make-cons-cell (SUBST x y (CAR z)) (SUBST x y (CDR z)))))
-
-(defn APPEND
-  "Append the the elements of `y` to the elements of `x`.
-
-  All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
-  See page 11 of the Lisp 1.5 Programmers Manual."
-  [x y]
-  (cond
-    (= x NIL) y
-    :else
-    (make-cons-cell (CAR x) (APPEND (CDR x) y))))
-
-(defn MEMBER
-  "This predicate is true if the S-expression `x` occurs among the elements
-  of the list `y`.
-
-  All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
-  See page 11 of the Lisp 1.5 Programmers Manual."
-  [x y]
-  (cond
-    (= y NIL) F ;; NOTE: returns F on falsity, not NIL
-    (= (EQUAL x (CAR y)) T) T
-    :else (MEMBER x (CDR y))))
-
-(defn PAIRLIS
-  "This function gives the list of pairs of corresponding elements of the
-  lists `x` and `y`, and APPENDs this to the list `a`. The resultant list
-  of pairs, which is like a table with two columns, is called an
-  association list.
-
-  Eessentially, it builds the environment on the stack, implementing shallow
-  binding.
-
-  All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
-  See page 12 of the Lisp 1.5 Programmers Manual."
-  [x y a]
-  (cond
-    ;; the original tests only x; testing y as well will be a little more
-    ;; robust if `x` and `y` are not the same length.
-    (or (= NIL x) (= NIL y)) a
-    :else (make-cons-cell
-           (make-cons-cell (CAR x) (CAR y))
-           (PAIRLIS (CDR x) (CDR y) a))))
-
-(defmacro QUOTE
-  "Quote, but in upper case for LISP 1.5"
-  [f]
-  `(quote ~f))
-
-(defn ASSOC
-  "If a is an association list such as the one formed by PAIRLIS in the above
-  example, then assoc will produce the first pair whose first term is x. Thus
-  it is a table searching function.
-
-  All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
-  See page 12 of the Lisp 1.5 Programmers Manual."
-  [x a]
-  (cond
-    (= NIL a) NIL ;; this clause is not present in the original but is added for
-    ;; robustness.
-    (= (EQUAL (CAAR a) x) T) (CAR a)
-    :else
-    (ASSOC x (CDR a))))
-
-(defn- SUB2
-  "Internal to `SUBLIS`, q.v., which SUBSTitutes into a list from a store.
-  ? I think this is doing variable binding in the stack frame?"
-  [a z]
-  (cond
-    (= NIL a) z
-    (= (CAAR a) z) (CDAR a) ;; TODO: this looks definitely wrong
-    :else
-    (SUB2 (CDR a) z)))
-
-(defn SUBLIS
-  "Here `a` is assumed to be an association list of the form
-  `((ul . vl)...(un . vn))`, where the `u`s are atomic, and `y` is any
-  S-expression. What `SUBLIS` does, is to treat the `u`s as variables when
-  they occur in `y`, and to SUBSTitute the corresponding `v`s from the pair
-  list.
-
-  My interpretation is that this is variable binding in the stack frame.
-
-  All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
-  See page 12 of the Lisp 1.5 Programmers Manual."
-  [a y]
-  (cond
-    (= (ATOM? y) T) (SUB2 a y)
-    :else
-    (make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
 
 (defn interop-interpret-q-name
   "For interoperation with Clojure, it will often be necessary to pass
@@ -318,10 +180,10 @@
       f      (cond
                (try
                  (fn? (eval l-name))
-                 (catch java.lang.ClassNotFoundException e nil)) l-name
+                 (catch java.lang.ClassNotFoundException _ nil)) l-name
                (try
                  (fn? (eval q-name))
-                 (catch java.lang.ClassNotFoundException e nil)) q-name
+                 (catch java.lang.ClassNotFoundException _ nil)) q-name
                :else (throw
                       (ex-info
                        (str "INTEROP: unknown function `" fn-symbol "`")
@@ -353,48 +215,6 @@
       {:cause  :interop
        :detail :strict}))))
 
-(defn OBLIST
-  "Return a list of the symbols currently bound on the object list.
-   
-   **NOTE THAT** in the Lisp 1.5 manual, footnote at the bottom of page 69, it implies 
-   that an argument can be passed but I'm not sure of the semantics of
-   this."
-  []
-  (if (instance? ConsCell @oblist)
-    (make-beowulf-list (map CAR @oblist))
-    NIL))
-
-(defn DEFINE
-  "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten 
-  in LISP. 
-
-  The single argument to `DEFINE` should be an assoc list which should be 
-  nconc'ed onto the front of the oblist. Broadly, 
-  (SETQ OBLIST (NCONC ARG1 OBLIST))"
-  [args]
-  (swap!
-   oblist
-   (fn [ob arg1]
-     (loop [cursor arg1 a arg1]
-       (if (= (CDR cursor) NIL)
-         (do
-           (.rplacd cursor @oblist)
-           (pretty-print a)
-           a)
-         (recur (CDR cursor) a))))
-   (CAR args)))
-
-(defn SET
-  "Implementation of SET in Clojure. Add to the `oblist` a binding of the
-   value of `var` to the value of `val`. NOTE WELL: this is not SETQ!"
-  [symbol val]
-  (when
-   (swap!
-    oblist
-    (fn [ob s v] (make-cons-cell (make-cons-cell s v) ob))
-    symbol val)
-    NIL))
-
 (defn- traced-apply
   "Like `APPLY`, but with trace output to console."
   [function-symbol args lisp-fn environment depth]
@@ -429,12 +249,11 @@
         (case function-symbol ;; there must be a better way of doing this!
           ADD1 (safe-apply ADD1 args)
           AND (safe-apply AND args)
-          APPEND (safe-apply APPEND args)
           APPLY (safe-apply APPLY args) ;; TODO: need to pass the environment and depth
           ATOM (ATOM? (CAR args))
-          CAR (CAAR args)
+          CAR (safe-apply CAR args)
-          CDR (CDAR args)
+          CDR (safe-apply CDR args)
-          CONS (make-cons-cell (CAR args) (CADR args))
+          CONS (safe-apply CONS args)
           DEFINE (DEFINE (CAR args))
           DIFFERENCE (DIFFERENCE (CAR args) (CADR args))
           EQ (safe-apply EQ args)

src/beowulf/cons_cell.clj

@@ -5,6 +5,26 @@
   of Clojure lists."
   (:require [beowulf.oblist :refer [NIL]]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (declare cons-cell?)
 
 (def T
@@ -16,6 +36,8 @@
   false in Lisp 1.5."
   (symbol "F")) ;; false as distinct from nil
 
+;;;; The actual cons-cell ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defprotocol MutableSequence
   "Like a sequence, but mutable."
   (rplaca
@@ -32,8 +54,7 @@
     "like `more`, q.v., but returns List `NIL` not Clojure `nil` when empty.")
   (getUid
     [this]
-   "Returns a unique identifier for this object")
+    "Returns a unique identifier for this object"))
-  )
 
 (deftype ConsCell [^:unsynchronized-mutable CAR ^:unsynchronized-mutable CDR uid]
   ;; Note that, because the CAR and CDR fields are unsynchronised mutable - i.e.
@@ -140,11 +161,17 @@
            (= NIL (. this CDR)) ")"
            :else (str " . " (. this CDR) ")")))))
 
+;;;; Printing. Here be dragons! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn- to-string
   "Printing ConsCells gave me a *lot* of trouble. This is an internal function
   used by the print-method override (below) in order that the standard Clojure
   `print` and `str` functions will print ConsCells correctly. The argument
   `cell` must, obviously, be an instance of `ConsCell`."
+  ;; TODO: I am deeply suspicious both of this and the defmethod which depends 
+  ;; on it. I *think* they are implicated in the `COPY` bug. If the `toString`
+  ;; override in `ConsCell` was right, neither of these would be necessary.
+  ;; see https://github.com/simon-brooke/beowulf/issues/5
   [cell]
   (loop [c cell
          n 0
@@ -170,6 +197,12 @@
           ss))
       (str c))))
 
+(defmethod clojure.core/print-method
+  ;;; I have not worked out how to document defmethod without blowing up the world.
+  beowulf.cons_cell.ConsCell
+  [this writer]
+  (.write writer (to-string this)))
+
 (defn pretty-print
   "This isn't the world's best pretty printer but it sort of works."
   ([^beowulf.cons_cell.ConsCell cell]
@@ -204,12 +237,10 @@
            ss))
        (str c)))))
 
-
+(defn cons-cell?
-(defmethod clojure.core/print-method
+  "Is this object `o` a beowulf cons-cell?"
-  ;;; I have not worked out how to document defmethod without blowing up the world.
+  [o]
-  beowulf.cons_cell.ConsCell
+  (instance? beowulf.cons_cell.ConsCell o))
-  [this writer]
-  (.write writer (to-string this)))
 
 (defn make-cons-cell
   "Construct a new instance of cons cell with this `car` and `cdr`."
@@ -220,11 +251,6 @@
       (throw (ex-info "Cound not construct cons cell" {:car car
                                                        :cdr cdr} any)))))
 
-(defn cons-cell?
-  "Is this object `o` a beowulf cons-cell?"
-  [o]
-  (instance? beowulf.cons_cell.ConsCell o))
-
 (defn make-beowulf-list
   "Construct a linked list of cons cells with the same content as the
   sequence `x`."
@@ -245,36 +271,3 @@
       (throw (ex-info "Could not construct Beowulf list"
                       {:content x}
                       any)))))
-
-(defn CONS
-  "Construct a new instance of cons cell with this `car` and `cdr`."
-  [car cdr]
-  (beowulf.cons_cell.ConsCell. car cdr (gensym "c")))
-
-(defn CAR
-  "Return the item indicated by the first pointer of a pair. NIL is treated
-  specially: the CAR of NIL is NIL."
-  [x]
-  (if
-   (= x NIL) NIL
-   (try
-     (or (.getCar x) NIL)
-     (catch Exception any
-       (throw (Exception.
-               (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")") any))))))
-
-(defn CDR
-  "Return the item indicated by the second pointer of a pair. NIL is treated
-  specially: the CDR of NIL is NIL."
-  [x]
-  (if
-   (= x NIL) NIL
-   (try
-     (.getCdr x)
-     (catch Exception any
-       (throw (Exception.
-               (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")") any))))))
-
-(defn LIST
-  [& args]
-  (make-beowulf-list args))

src/beowulf/core.clj

@@ -1,7 +1,7 @@
 (ns beowulf.core
   "Essentially, the `-main` function and the bootstrap read-eval-print loop."
   (:require [beowulf.bootstrap :refer [EVAL]]
-            [beowulf.io :refer [SYSIN]]
+            [beowulf.io :refer [default-sysout SYSIN]]
             [beowulf.read :refer [READ read-from-console]]
             [beowulf.oblist :refer [*options* oblist]]
             [clojure.java.io :as io]
@@ -10,6 +10,26 @@
             [clojure.tools.cli :refer [parse-opts]])
   (:gen-class))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (def stop-word "STOP")
 
 (def cli-options
@@ -24,7 +44,7 @@
    ["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT"
     :default "Sprecan::"]
    ["-r INITFILE" "--read INITFILE" "Read Lisp system from file INITFILE"
-    :default "resources/lisp1.5.lsp"
+    :default default-sysout
     :validate [#(and
                  (.exists (io/file %))
                  (.canRead (io/file %)))

src/beowulf/gendoc.clj

@@ -1,6 +1,31 @@
 (ns beowulf.gendoc
-  (:require [beowulf.oblist :refer [oblist]]
+  "Generate table of documentation of Lisp symbols and functions.
-            [clojure.string :refer [join replace]]))
+   
+   NOTE: this is *very* hacky. You almost certainly do not want to 
+   use this!"
+  (:require [beowulf.io :refer [default-sysout SYSIN]]
+            [beowulf.oblist :refer [oblist]]
+            [clojure.string :refer [join replace upper-case]]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def host-functions
   "Functions which we can infer are written in Clojure."
@@ -35,22 +60,43 @@
   (let [fn (host-functions (symbol (first entry)))]
     (get-metadata-for-function fn key)))
 
-
 (defn infer-type
+  "Try to work out what this `entry` from the oblist actually
+   represents."
   [entry]
   (cond
     (= (second entry) 'LAMBDA) "Lisp function"
-    (host-functions (first entry)) "Host function"
+    (= (second entry) 'LABEL) "Labeled form"
-    :else "?"))
+    (host-functions (first entry)) (if (fn? (eval (symbol (host-functions (first entry)))))
+                                     "Host function"
+                                     "Host variable")
+    :else "Lisp variable"))
+
+(defn- format-clj-signature
+  "Format the signature of the Clojure function represented by `symbol` for
+   Lisp documentation."
+  [symbol arglists]
+  (join
+   "; "
+   (map
+    (fn [l]
+      (str
+       (cons symbol
+             (map #(upper-case (str %)) l))))
+    arglists)))
 
 (defn infer-signature
+  "Infer the signature of the function value of this oblist `entry`, if any."
   [entry]
   (cond
-    (= (count entry) 1) (get-metadata-for-entry entry :arglists)
+    (= (count entry) 1) (format-clj-signature
-    (= (second entry) 'LAMBDA) (nth entry 2)
+                         (first entry)
+                         (get-metadata-for-entry entry :arglists))
+    (= (second entry) 'LAMBDA) (str (cons (first entry) (nth entry 2)))
     :else "?"))
 
 (defn find-documentation
+  "Find appropriate documentation for this `entry` from the oblist."
   [entry]
   (cond
     (= (count entry) 1) (if-let [doc (get-metadata-for-entry entry :doc)]
@@ -59,7 +105,12 @@
     :else "?"))
 
 (defn gen-doc-table
-  []
+  ([]
+   (gen-doc-table default-sysout))
+  ([sysfile]
+   (try (SYSIN sysfile)
+        (catch Throwable any
+          (println (.getMessage any) " while reading " sysfile)))
    (join
     "\n"
     (doall
@@ -72,6 +123,6 @@
                 (infer-type %)
                 (infer-signature %)
                 (find-documentation %))
-      @oblist)))))
+       @oblist))))))
 
 ;; (println (gen-doc-table))

src/beowulf/host.clj

@@ -3,27 +3,152 @@
    be) implemented in Lisp 1.5, which therefore need to be implemented in the
    host language, in this case Clojure."
   (:require [clojure.string :refer [upper-case]]
-            [beowulf.cons-cell :refer [F make-beowulf-list T]]
+            [beowulf.cons-cell :refer [F make-cons-cell make-beowulf-list 
+                                       pretty-print T]]
             ;; note hyphen - this is Clojure...
-            [beowulf.oblist :refer [NIL]])
+            [beowulf.oblist :refer [*options* oblist NIL]])
   (:import [beowulf.cons_cell ConsCell]
            ;; note underscore - same namespace, but Java.
            ))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 ;; these are CANDIDATES to be host-implemented. only a subset of them MUST be.
 ;; those which can be implemented in Lisp should be, since that aids
 ;; portability.
 
-(defn AND 
-  "`T` if and only if none of my `args` evaluate to either `F` or `NIL`,
-   else `F`.
 
-   In `beowulf.host` principally because I don't yet feel confident to define
+(defn lax?
-   varargs functions in Lisp."
+  "Are we in lax mode? If so. return true; is not, throw an exception with 
-  [& args]
+   this `symbol`."
-  (if (empty? (filter #(or (= 'F %) (= NIL %) (nil? %)) args))
+  [symbol]
-    'T
+  (when (:strict *options*)
-    'F))
+    (throw (ex-info (format "%s is not available in Lisp 1.5" symbol)
+                    {:type :strict
+                     :phase :host
+                     :function symbol})))
+  true)
+
+;;;; Basic operations on cons cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn CONS
+  "Construct a new instance of cons cell with this `car` and `cdr`."
+  [car cdr]
+  (beowulf.cons_cell.ConsCell. car cdr (gensym "c")))
+
+(defn CAR
+  "Return the item indicated by the first pointer of a pair. NIL is treated
+  specially: the CAR of NIL is NIL."
+  [x]
+  (if
+   (= x NIL) NIL
+   (try
+     (or (.getCar x) NIL)
+     (catch Exception any
+       (throw (ex-info
+               (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")
+               {:phase :host
+                :function 'CAR
+                :args (list x)
+                :type :beowulf}
+               ;; startlingly, Lisp 1.5 did not flag an error when you took the
+               ;; CAR of something that wasn't cons cell. The result, as the
+               ;; manual says (page 56), could be garbage.
+               any))))))
+
+(defn CDR
+  "Return the item indicated by the second pointer of a pair. NIL is treated
+  specially: the CDR of NIL is NIL."
+  [x]
+  (if
+   (= x NIL) NIL
+   (try
+     (.getCdr x)
+     (catch Exception any
+       (throw (ex-info
+               (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")")
+               {:phase :host
+                :function 'CDR
+                :args (list x)
+                :type :beowulf}
+               ;; startlingly, Lisp 1.5 did not flag an error when you took the
+               ;; CAR of something that wasn't cons cell. The result, as the
+               ;; manual says (page 56), could be garbage.
+               any))))))
+
+(defn uaf
+  "Universal access function; `l` is expected to be an arbitrary LISP list, `path`
+  a (clojure) list of the characters `a` and `d`. Intended to make declaring
+  all those fiddly `#'c[ad]+r'` functions a bit easier"
+  [l path]
+  (cond
+    (= l NIL) NIL
+    (empty? path) l
+    :else
+    (try
+      (case (last path)
+        \a (uaf (.first l) (butlast path))
+        \d (uaf (.getCdr l) (butlast path))
+        (throw (ex-info (str "uaf: unexpected letter in path (only `a` and `d` permitted): " (last path))
+                        {:cause  :uaf
+                         :detail :unexpected-letter
+                         :expr   (last path)})))
+      (catch ClassCastException e
+        (throw (ex-info
+                (str "uaf: Not a LISP list? " (type l))
+                {:cause  :uaf
+                 :detail :not-a-lisp-list
+                 :expr   l}
+                e))))))
+
+(defmacro CAAR [x] `(uaf ~x '(\a \a)))
+(defmacro CADR [x] `(uaf ~x '(\a \d)))
+(defmacro CDDR [x] `(uaf ~x '(\d \d)))
+(defmacro CDAR [x] `(uaf ~x '(\d \a)))
+
+(defmacro CAAAR [x] `(uaf ~x '(\a \a \a)))
+(defmacro CAADR [x] `(uaf ~x '(\a \a \d)))
+(defmacro CADAR [x] `(uaf ~x '(\a \d \a)))
+(defmacro CADDR [x] `(uaf ~x '(\a \d \d)))
+(defmacro CDDAR [x] `(uaf ~x '(\d \d \a)))
+(defmacro CDDDR [x] `(uaf ~x '(\d \d \d)))
+(defmacro CDAAR [x] `(uaf ~x '(\d \a \a)))
+(defmacro CDADR [x] `(uaf ~x '(\d \a \d)))
+
+(defmacro CAAAAR [x] `(uaf ~x '(\a \a \a \a)))
+(defmacro CAADAR [x] `(uaf ~x '(\a \a \d \a)))
+(defmacro CADAAR [x] `(uaf ~x '(\a \d \a \a)))
+(defmacro CADDAR [x] `(uaf ~x '(\a \d \d \a)))
+(defmacro CDDAAR [x] `(uaf ~x '(\d \d \a \a)))
+(defmacro CDDDAR [x] `(uaf ~x '(\d \d \d \a)))
+(defmacro CDAAAR [x] `(uaf ~x '(\d \a \a \a)))
+(defmacro CDADAR [x] `(uaf ~x '(\d \a \d \a)))
+(defmacro CAAADR [x] `(uaf ~x '(\a \a \a \d)))
+(defmacro CAADDR [x] `(uaf ~x '(\a \a \d \d)))
+(defmacro CADADR [x] `(uaf ~x '(\a \d \a \d)))
+(defmacro CADDDR [x] `(uaf ~x '(\a \d \d \d)))
+(defmacro CDDADR [x] `(uaf ~x '(\d \d \a \d)))
+(defmacro CDDDDR [x] `(uaf ~x '(\d \d \d \d)))
+(defmacro CDAADR [x] `(uaf ~x '(\d \a \a \d)))
+(defmacro CDADDR [x] `(uaf ~x '(\d \a \d \d)))
 
 (defn RPLACA
   "Replace the CAR pointer of this `cell` with this `value`. Dangerous, should
@@ -75,6 +200,150 @@
             {:cause :bad-value
              :detail :rplaca}))));; PLUS
 
+(defn LIST
+  [& args]
+  (make-beowulf-list args))
+
+;;;; Basic predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro NULL
+  "Returns `T` if and only if the argument `x` is bound to `NIL`; else `F`."
+  [x]
+  `(if (= ~x NIL) T F))
+
+(defmacro NILP
+  "Not part of LISP 1.5: `T` if `o` is `NIL`, else `NIL`."
+  [x]
+  `(if (= ~x NIL) T NIL))
+
+(defn ATOM
+  "Returns `T` if and only if the argument `x` is bound to an atom; else `F`.
+  It is not clear to me from the documentation whether `(ATOM 7)` should return
+  `T` or `F`. I'm going to assume `T`."
+  [x]
+  (if (or (symbol? x) (number? x)) T F))
+
+(defmacro ATOM?
+  "The convention of returning `F` from predicates, rather than `NIL`, is going
+  to tie me in knots. This is a variant of `ATOM` which returns `NIL`
+  on failure."
+  [x]
+  `(if (or (symbol? ~x) (number? ~x)) T NIL))
+
+(defn EQ
+  "Returns `T` if and only if both `x` and `y` are bound to the same atom,
+  else `NIL`."
+  [x y]
+  (cond (and (instance? ConsCell x)
+             (.equals x y)) T
+        (and (= (ATOM x) T) (= x y)) T
+        :else NIL))
+
+(defn EQUAL
+  "This is a predicate that is true if its two arguments are identical
+  S-expressions, and false if they are different. (The elementary predicate
+  `EQ` is defined only for atomic arguments.) The definition of `EQUAL` is
+  an example of a conditional expression inside a conditional expression.
+
+  NOTE: returns `F` on failure, not `NIL`"
+  [x y]
+  (cond
+    (= (ATOM x) T) (if (= x y) T F)
+    (= (EQUAL (CAR x) (CAR y)) T) (EQUAL (CDR x) (CDR y))
+    :else F))
+
+(defn AND 
+  "`T` if and only if none of my `args` evaluate to either `F` or `NIL`,
+   else `F`.
+   
+   In `beowulf.host` principally because I don't yet feel confident to define
+   varargs functions in Lisp."
+  [& args]
+  (if (empty? (filter #(or (= 'F %) (= NIL %) (nil? %)) args))
+    'T
+    'F))
+
+;;;; Operations on lists ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; TODO: These are candidates for moving to Lisp urgently!
+
+(defn ASSOC
+  "If a is an association list such as the one formed by PAIRLIS in the above
+  example, then assoc will produce the first pair whose first term is x. Thus
+  it is a table searching function.
+
+  All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+  See page 12 of the Lisp 1.5 Programmers Manual."
+  [x a]
+  (cond
+    (= NIL a) NIL ;; this clause is not present in the original but is added for
+    ;; robustness.
+    (= (EQUAL (CAAR a) x) T) (CAR a)
+    :else
+    (ASSOC x (CDR a))))
+
+(defn- SUB2
+  "Internal to `SUBLIS`, q.v., which SUBSTitutes into a list from a store.
+  ? I think this is doing variable binding in the stack frame?"
+  [a z]
+  (cond
+    (= NIL a) z
+    (= (CAAR a) z) (CDAR a) ;; TODO: this looks definitely wrong
+    :else
+    (SUB2 (CDR a) z)))
+
+(defn SUBLIS
+  "Here `a` is assumed to be an association list of the form
+  `((ul . vl)...(un . vn))`, where the `u`s are atomic, and `y` is any
+  S-expression. What `SUBLIS` does, is to treat the `u`s as variables when
+  they occur in `y`, and to SUBSTitute the corresponding `v`s from the pair
+  list.
+
+  My interpretation is that this is variable binding in the stack frame.
+
+  All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+  See page 12 of the Lisp 1.5 Programmers Manual."
+  [a y]
+  (cond
+    (= (ATOM? y) T) (SUB2 a y)
+    :else
+    (make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
+
+(defn SUBST
+  "This function gives the result of substituting the S-expression `x` for
+  all occurrences of the atomic symbol `y` in the S-expression `z`."
+  [x y z]
+  (cond
+    (= (EQUAL y z) T) x
+    (= (ATOM? z) T) z ;; NIL is a symbol
+    :else
+    (make-cons-cell (SUBST x y (CAR z)) (SUBST x y (CDR z)))))
+
+(defn PAIRLIS
+  "This function gives the list of pairs of corresponding elements of the
+  lists `x` and `y`, and APPENDs this to the list `a`. The resultant list
+  of pairs, which is like a table with two columns, is called an
+  association list.
+
+  Eessentially, it builds the environment on the stack, implementing shallow
+  binding.
+
+  All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
+  See page 12 of the Lisp 1.5 Programmers Manual."
+  [x y a]
+  (cond
+    ;; the original tests only x; testing y as well will be a little more
+    ;; robust if `x` and `y` are not the same length.
+    (or (= NIL x) (= NIL y)) a
+    :else (make-cons-cell
+           (make-cons-cell (CAR x) (CAR y))
+           (PAIRLIS (CDR x) (CDR y) a))))
+
+;;;; Arithmetic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; TODO: When in strict mode, should we limit arithmetic precision to that
+;; supported by Lisp 1.5?
+
 (defn PLUS
   [& args]
   (let [s (apply + args)]
@@ -118,6 +387,16 @@
   [x]
   (if (number? x) T F))
 
+(defn LESSP
+  [x y]
+  (< x y))
+
+(defn GREATERP
+  [x y]
+  (> x y))
+
+;;;; Miscellaneous ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn GENSYM
   "Generate a unique symbol."
   []
@@ -129,10 +408,70 @@
   (throw (ex-info "LISP ERROR" {:cause (apply vector args)
                                 :phase :eval})))
 
-(defn LESSP
+;;;; Assignment and the object list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  [x y]
-  (< x y))
 
-(defn GREATERP
+(defn OBLIST
-  [x y]
+  "Return a list of the symbols currently bound on the object list.
-  (> x y))
+   
+   **NOTE THAT** in the Lisp 1.5 manual, footnote at the bottom of page 69, it implies 
+   that an argument can be passed but I'm not sure of the semantics of
+   this."
+  []
+  (if (instance? ConsCell @oblist)
+    (make-beowulf-list (map CAR @oblist))
+    NIL))
+
+(defn DEFINE
+  "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten 
+  in LISP. 
+
+  The single argument to `DEFINE` should be an assoc list which should be 
+  nconc'ed onto the front of the oblist. Broadly, 
+  (SETQ OBLIST (NCONC ARG1 OBLIST))"
+  [args]
+  (swap!
+   oblist
+   (fn [ob arg1]
+     (loop [cursor arg1 a arg1]
+       (if (= (CDR cursor) NIL)
+         (do
+           (.rplacd cursor @oblist)
+           (pretty-print a)
+           a)
+         (recur (CDR cursor) a))))
+   (CAR args)))
+
+(defn SET
+  "Implementation of SET in Clojure. Add to the `oblist` a binding of the
+   value of `var` to the value of `val`. NOTE WELL: this is not SETQ!"
+  [symbol val]
+  (when
+   (swap!
+    oblist
+    (fn [ob s v] (make-cons-cell (make-cons-cell s v) ob))
+    symbol val)
+    NIL))
+
+;;;; TRACE and friends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def traced-symbols
+  "Symbols currently being traced."
+  (atom #{}))
+
+(defn traced?
+  "Return `true` iff `s` is a symbol currently being traced, else `nil`."
+  [s]
+  (try (contains? @traced-symbols s)
+       (catch Throwable _)))
+
+(defn TRACE
+  "Add this symbol `s` to the set of symbols currently being traced. If `s`
+   is not a symbol, does nothing."
+  [s]
+  (when (symbol? s)
+    (swap! traced-symbols #(conj % s))))
+
+(defn UNTRACE
+  [s]
+  (when (symbol? s)
+    (swap! traced-symbols #(set (remove (fn [x] (= s x)) %)))))

src/beowulf/io.clj

@@ -22,6 +22,28 @@
             [clojure.string :refer [ends-with?]]
             [java-time.api :refer [local-date local-date-time]]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:constant default-sysout "resources/lisp1.5.lsp")
+
 (defn- full-path 
   [fp]
   (str
@@ -72,7 +94,7 @@
    if you're writing it from the Lisp REPL, it won't), the extension `.lsp`
    will be appended."
   ([]
-   (SYSIN (or (:read *options*) "resources/lisp1.5.lsp")))
+   (SYSIN (or (:read *options*) default-sysout)))
   ([filename]
   (let [fp (file (full-path (str filename)))
         file (when (and (.exists fp) (.canRead fp)) fp)

src/beowulf/oblist.clj

@@ -1,10 +1,31 @@
 (ns beowulf.oblist
-  "A namespace mainly devoted to the object list.
+  "A namespace mainly devoted to the object list and other top level
+   global variables.
    
-   Yes, this makes little sense, but if you put it anywhere else you end
+   Yes, this makes little sense, but if you put them anywhere else you end
    up in cyclic dependency hell."
   )
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (def NIL
   "The canonical empty list symbol.
    

src/beowulf/read.clj

@@ -28,6 +28,24 @@
 ;;; the real Lisp reader.
 ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn strip-line-comments
   "Strip blank lines and comment lines from this string `s`, expected to

src/beowulf/reader/char_reader.clj

@@ -19,6 +19,26 @@
   (:import [org.jline.reader LineReader LineReaderBuilder]
            [org.jline.terminal TerminalBuilder]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 ;; It looks from the example given [here](https://github.com/jline/jline3/blob/master/demo/src/main/java/org/jline/demo/Repl.java)
 ;; as though JLine could be used to build a perfect line-reader for Beowulf; but it also
 ;; looks as though you'd need a DPhil in JLine to write it, and I don't have

src/beowulf/reader/generate.clj

@@ -61,6 +61,25 @@
             [clojure.math.numeric-tower :refer [expt]]
             [clojure.string :refer [upper-case]]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (declare generate)
 

src/beowulf/reader/macros.clj

@@ -1,17 +1,48 @@
 (ns beowulf.reader.macros
-  "Can I implement reader macros? let's see!"
+  "Can I implement reader macros? let's see!
-  (:require [beowulf.cons-cell :refer [CONS LIST make-beowulf-list]]
-            [clojure.string :refer [join]])
-  (:import [beowulf.cons_cell ConsCell]))
    
-;; We don't need (at least, in the Clojure reader) to rewrite forms like
+   We don't need (at least, in the Clojure reader) to rewrite forms like
-;; "'FOO", because that's handled by the parser. But we do need to rewrite
+   `'FOO`, because that's handled by the parser. But we do need to rewrite
-;; things which don't evaluate their arguments, like `SETQ`, because (unless
+   things which don't evaluate their arguments, like `SETQ`, because (unless
-;; LABEL does it, which I'm not yet sure of) we're not yet able to implement
+   LABEL does it, which I'm not yet sure of) we're not yet able to implement
-;; things which don't evaluate arguments.
+   things which don't evaluate arguments.
 
-;; TODO: at this stage, the following should probably also be read macros:
+   TODO: at this stage, the following should probably also be read macros:
-;; DEFINE
+   DEFINE"
+  (:require [beowulf.cons-cell :refer [make-beowulf-list]]
+            [beowulf.host :refer [CONS LIST]]
+            [clojure.string :refer [join]]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; We don't need (at least, in the Clojure reader) to rewrite forms like
+;;; "'FOO", because that's handled by the parser. But we do need to rewrite
+;;; things which don't evaluate their arguments, like `SETQ`, because (unless
+;;; LABEL does it, which I'm not yet sure of) we're not yet able to implement
+;;; things which don't evaluate arguments.
+;;;
+;;; TODO: at this stage, the following should probably also be read macros:
+;;; DEFINE
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def ^:dynamic *readmacros*
   {:car {'DEFUN (fn [f]

src/beowulf/reader/parser.clj

@@ -2,6 +2,26 @@
   "The actual parser, supporting both S-expression and M-expression syntax."
   (:require [instaparse.core :as i]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (def parse
   "Parse a string presented as argument into a parse tree which can then
   be operated upon further."

src/beowulf/reader/simplify.clj

@@ -5,6 +5,26 @@
             [instaparse.failure :as f])
   (:import [instaparse.gll Failure]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright (C) 2022-2023 Simon Brooke
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (declare simplify)
 
 (defn remove-optional-space

src/beowulf/trace.clj

@@ -1,24 +0,0 @@
-(ns beowulf.trace
-  "Tracing of function execution")
-
-(def traced-symbols
-  "Symbols currently being traced."
-  (atom #{}))
-
-(defn traced?
-  "Return `true` iff `s` is a symbol currently being traced, else `nil`."
-  [s]
-  (try (contains? @traced-symbols s)
-       (catch Throwable _)))
-
-(defn TRACE
-  "Add this symbol `s` to the set of symbols currently being traced. If `s`
-   is not a symbol, does nothing."
-  [s]
-  (when (symbol? s)
-    (swap! traced-symbols #(conj % s))))
-
-(defn UNTRACE
-  [s]
-  (when (symbol? s)
-    (swap! traced-symbols #(set (remove (fn [x] (= s x)) %)))))

test/beowulf/bootstrap_test.clj

@@ -1,8 +1,8 @@
 (ns beowulf.bootstrap-test
   (:require [clojure.test :refer [deftest testing is]]
-            [beowulf.cons-cell :refer [CAR CDR make-cons-cell T F]]
+            [beowulf.cons-cell :refer [make-cons-cell T F]]
-            [beowulf.bootstrap :refer [APPEND ASSOC ATOM ATOM? CAAAAR CADR
+            [beowulf.host :refer [ASSOC ATOM ATOM? CAR CAAAAR CADR
-                                       CADDR CADDDR EQ EQUAL MEMBER 
+                                       CADDR CADDDR CDR EQ EQUAL 
                                        PAIRLIS SUBLIS SUBST]]
             [beowulf.oblist :refer [NIL]]
             [beowulf.read :refer [gsp]]))
@@ -165,44 +165,6 @@
                      (gsp "((A . B) . C)")))]
       (is (= actual expected)))))
 
-(deftest append-tests
-  (testing "append"
-    (let [expected "(A B C . D)"
-          actual (print-str
-                   (APPEND
-                     (gsp "(A B)")
-                     (gsp "(C . D)")))]
-      (is (= actual expected)))
-    (let [expected "(A B C D E)"
-          actual (print-str
-                   (APPEND
-                     (gsp "(A B)")
-                     (gsp "(C D E)")))]
-      (is (= actual expected)))))
-
-(deftest member-tests
-  (testing "member"
-    (let [expected 'T
-          actual (MEMBER
-                   (gsp "ALBERT")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-      (is (= actual expected)))
-    (let [expected 'T
-          actual (MEMBER
-                   (gsp "BELINDA")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-       (is (= actual expected)))
-    (let [expected 'T
-          actual (MEMBER
-                   (gsp "ELFREDA")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-       (is (= actual expected)))
-    (let [expected 'F
-          actual (MEMBER
-                   (gsp "BERTRAM")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-       (is (= actual expected)))))
-
 (deftest pairlis-tests
   (testing "pairlis"
     (let [expected "((A . U) (B . V) (C . W) (D . X) (E . Y))"

test/beowulf/host_test.clj

@@ -1,7 +1,7 @@
 (ns beowulf.host-test
   (:require [clojure.test :refer [deftest is testing]]
-            [beowulf.cons-cell :refer [CDR F make-beowulf-list T]] 
+            [beowulf.cons-cell :refer [F make-beowulf-list T]] 
-            [beowulf.host :refer [DIFFERENCE NUMBERP PLUS RPLACA RPLACD TIMES]]
+            [beowulf.host :refer [CDR DIFFERENCE NUMBERP PLUS RPLACA RPLACD TIMES]]
             [beowulf.oblist :refer [NIL]]
             [beowulf.read :refer [gsp]]))
 

test/beowulf/lisp_test.clj

@@ -4,29 +4,147 @@
             [beowulf.bootstrap :refer [EVAL]]
             [beowulf.cons-cell :refer [make-beowulf-list]]
             [beowulf.io :refer [SYSIN]]
+            ;; [beowulf.oblist :refer [NIL]]
             [beowulf.read :refer [READ]]))
 
-;; (use-fixtures :once (fn [f]
+(defn- reps
-;;                        (try (SYSIN "resources/lisp1.5.lsp")
+  "'Read eval print string', or 'read eval print single'.
-;;                        (f)
+   Reads and evaluates one input string, and returns the
-;;                             (catch Throwable any
+   output string."
-;;                               (throw (ex-info "Failed to load Lisp sysout"
+  [input]
-;;                                               {:phase test
+  (with-out-str (print (EVAL (READ input)))))
-;;                                                :function 'SYSIN
+
-;;                                                :file "resources/lisp1.5.lsp"}))))))
+(use-fixtures :once (fn [f]
+                      (try (when (SYSIN "resources/lisp1.5.lsp")
+                             (f))
+                           (catch Throwable any
+                             (throw (ex-info "Failed to load Lisp sysout"
+                                             {:phase test
+                                              :function 'SYSIN
+                                              :file "resources/lisp1.5.lsp"}
+                                             any))))))
+
+  (deftest APPEND-tests
+    (testing "append - dot-terminated lists"
+      (let [expected "(A B C . D)"
+            actual (reps "(APPEND '(A B) (CONS 'C 'D))")]
+        (is (= actual expected)))
+     (let [expected "(A B C . D)"
+           actual (reps "(APPEND (CONS 'A (CONS 'B NIL)) (CONS 'C 'D))")]
+       (is (= actual expected)))
+      ;; this is failing: https://github.com/simon-brooke/beowulf/issues/5
+      (let [expected "(A B C . D)"
+            actual (reps "(APPEND '(A B) '(C . D))")]
+        (is (= actual expected))))
+    (testing "append - straight lists" 
+      (let [expected "(A B C D E)"
+            actual (reps "(APPEND '(A B) '(C D E))")]
+        (is (= actual expected)))))
+
+(deftest COPY-tests
+  (testing "copy NIL"
+    (let [expected "NIL"
+          actual (with-out-str (print (EVAL (READ "(COPY NIL)"))))]
+      (is (= actual expected))))
+  (testing "copy straight list"
+    (let [expected (make-beowulf-list '(A B C))
+          actual (EVAL (READ "(COPY '(A B C))"))]
+      (is (= actual expected))))
+  (testing "copy assoc list created in READ"
+    ;; this is failing. Problem in READ?
+    ;; see https://github.com/simon-brooke/beowulf/issues/5
+    (let [expected (READ "((A . 1) (B . 2) (C . 3))")
+          actual (EVAL (READ "(COPY '((A . 1) (B . 2) (C . 3)))"))]
+      (is (= actual expected))))
+  (testing "copy assoc list created with PAIR"
+    (let [expected (READ "((A . 1) (B . 2) (C . 3))")
+          actual (EVAL (READ "(COPY (PAIR '(A B C) '(1 2 3)))"))]
+      (is (= actual expected)))))
+
+(deftest DIVIDE-tests
+  (testing "rational divide"
+    (let [expected "(4 0)"
+          input "(DIVIDE 8 2)"
+          actual (reps input)]
+      (is (= actual expected))))
+  (testing "irrational divide"
+    (let [expected "(3.142857 1)"
+          input "(DIVIDE 22 7)"
+          actual (reps input)]
+      (is (= actual expected))))
+  (testing "divide by zero"
+    (let [input "(DIVIDE 22 0)"]
+      (is (thrown-with-msg? ArithmeticException
+                            #"Divide by zero"
+                            (reps input)))))
+  
+  ;; TODO: need to write tests for GET but I don't really
+  ;; understand what the correct behaviour is.
+
+  (deftest INTERSECTION-tests
+    (testing "non-intersecting"
+      (let [expected "NIL"
+            input "(INTERSECTION '(A B C) '(D E F))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "intersection with NIL"
+      (let [expected "NIL"
+            input "(INTERSECTION '(A B C) NIL)"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "intersection with NIL (2)"
+      (let [expected "NIL"
+            input "(INTERSECTION NIL '(A B C))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "sequential intersection"
+      (let [expected "(C D)"
+            input "(INTERSECTION '(A B C D) '(C D E F))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "non-sequential intersection"
+      (let [expected "(C D)"
+            input "(INTERSECTION '(A B C D) '(F D E C))"
+            actual (reps input)]
+        (is (= actual expected)))))
+  
+  (deftest LENGTH-tests
+    (testing "length of NIL"
+      (let [expected "0"
+            input "(LENGTH NIL)"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "length of simple list"
+      (let [expected "3"
+            input "(LENGTH '(1 2 3))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "length of dot-terminated list"
+      (let [expected "3"
+            input "(LENGTH '(1 2 3 . 4))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "length of assoc list"
+      (let [expected "3"
+            input "(LENGTH (PAIR '(A B C) '(1 2 3)))"
+            actual (reps input)]
+        (is (= actual expected))))))
+       
+     
+(deftest MEMBER-tests
+  (testing "member"
+    (let [expected "T"
+          actual (reps "(MEMBER 'ALBERT '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))
+    (let [expected "T"
+          actual (reps "(MEMBER 'BELINDA '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))
+    (let [expected "T"
+          actual (reps "(MEMBER 'ELFREDA '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))
+    (let [expected "F"
+          actual (reps "(MEMBER 'BERTRAM '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))))
+
+       
   
-;; (deftest "COPY test"
-;;   ;; (testing "copy NIL"
-;;   ;;   (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
-;;   ;;   (let [expected "NIL"
-;;   ;;         actual (with-out-str (println (EVAL (READ "(COPY NIL)"))))]
-;;   ;;     (is (= actual expected))))
-;;   (testing "copy straight list"
-;;     (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
-;;     (let [expected (make-beowulf-list '(A B C))
-;;           actual (with-out-str (print (EVAL (READ "(COPY '(A B C))"))))]
-;;       (is (= actual expected))))
-;;   (testing "copy assoc list"
-;;     (let [expected "((A . 1) (B . 2) (C . 3))"
-;;           actual (with-out-str (println (EVAL (READ "(COPY '((A . 1) (B . 2) (C . 3)))"))))]
-;;       (is (= actual expected)))))