Right, there's an awful lot of Lisp actually working...

CHANGELOG.md

@@ -7,11 +7,19 @@ All notable changes to this project will be documented in this file. This change
 - this is fundamentally a working Lisp. The reader reads S-Expressions fully and M-Expressions at least partially. It is not (yet) a feature complete Lisp 1.5.
 
 ### Added
-- working EVAL, APPLY, READ and 24 other basic functions, of which at least four are not actually parts of the Lisp 1.5 specification. However, sufficient are present to allow the
+- working `EVAL`, `APPLY`, `READ` and 24 other basic functions, of which at least four are not actually parts of the Lisp 1.5 specification. However, sufficient are present to allow the
 vast majority of Lisp 1.5 functions to be defined.
 
 ### Known to be missing
-- property lists.
+
+- the array feature: `ARRAY`: planned, but not yet implemented.
+- constants: `CSET`, `CSETQ`: planned, but not yet implemented.
+- the compiler: `COMMON`, `COMPILE`, `LAP`, `OPDEFINE`, `READLAP`, `SPECIAL`, `UNCOMMON`, `UNSPECIAL`: not currently planned.
+- property lists: `ATTRIB`, `GETPROP`, `PUTPROP`; these are planned, but not yet implemented.
+- obsolete hardware related functions: `PUNCH`; not currently planned.
+- memory debugging: `COUNT`; not currently planned.
+- character I/O functions: `ADVANCE`, `CLEARBUFF`, `ENDREAD`, `INTERN`, `MKNAM`, `NUMOB`, `STARTREAD`, `UNPACK`; These are planned, but depend on working character I/O at Clojure level, which depends on JLine and looks like a lot of work.
+- character classifying predicates: `LITER`, `DIGIT`, `OPCHAR`, `DASH`; these are planned but will probably wait for character I/O. Characters are not at this stage first class objects.
 
 [Unreleased]: https://github.com/your-name/beowulf/compare/0.1.1...HEAD
 [0.1.1]: https://github.com/your-name/beowulf/compare/0.1.0...0.1.1

TEST.lsp

@@ -1,35 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Beowulf  Sysout file generated at 2023-03-29T12:34:39.278
-;; generated by simon
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-((NULL
-    LAMBDA (X) (COND ((EQUAL X (QUOTE NIL)) (QUOTE T)) ((QUOTE T) (QUOTE F))))
-  (GCD
-    LAMBDA
-    (X Y)
-    (COND
-      ((GREATERP X Y) (GCD Y X))
-      ((EQUAL (REMAINDER Y X) 0) X) ((QUOTE T) (GCD (REMAINDER Y X) X))))
-  (NIL)
-  (T . T)
-  (F)
-  (ADD1)
-  (APPEND)
-  (APPLY)
-  (ATOM)
-  (CAR)
-  (CDR)
-  (CONS)
-  (DEFINE)
-  (DIFFERENCE)
-  (EQ)
-  (EQUAL)
-  (EVAL)
-  (FIXP)
-  (INTEROP)
-  (NUMBERP)
-  (OBLIST)
-  (PLUS)
-  (PRETTY)
-  (QUOTIENT) (REMAINDER) (RPLACA) (RPLACD) (SET) (SYSIN) (SYSOUT) (TIMES))

doc/mexpr.md

@@ -53,7 +53,9 @@ Is the value of `NIL` the atom `NIL`, or is it the empty list `()`? If the forme
 
 > This is a predicate useful for deciding when a list is exhausted. It is true if and only if its argument is `NIL`.
 
-I think there is an ambiguity in referencing constants which are not bound to themselves in the M-Expression notation as given in the manual. This is particularly problematic with regards to `NIL`, but there may be others instances.
+`NIL` is used explicitly in an M-Expression for example in the definition of `intersection` (Ibid, p15).
+
+I think there is an ambiguity in referencing constants which are not bound to themselves in the M-Expression notation as given in the manual. This is particularly problematic with regards to `NIL` and `F`, but there may be others instances.
 
 ### Curly braces
 

project.clj

@@ -14,6 +14,7 @@
                  [clojure.java-time "1.2.0"]
                  [environ "1.2.0"]
                  [instaparse "1.4.12"]
+                 [org.jline/jline "3.23.0"]
                  [rhizome "0.2.9"] ;; not needed in production builds
                  ]
   :main ^:skip-aot beowulf.core

resources/bootstrap.lsp

@@ -1,2 +0,0 @@
-(COMMENT '(THIS FILE WILL CONTAIN FUNCTION DEFINITIONS TO BOOTSTRAP LISP FULLSTOP
-  AT PRESENT WE HAVE NO COMMENT SYNTAX))

resources/length.lsp

@@ -1 +0,0 @@
-(DEFUN LENGTH (L) (COND ((EQ NIL L) 0) (T (ADD1 (LENGTH (CDR L))))))

resources/lisp1.5.lsp

@@ -1,37 +1,77 @@
-;; Test comment
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-((NIL . NIL)
+;; Beowulf  Sysout file generated at 2023-03-30T09:40:36.483
-(T . T)
+;; generated by simon
-;; many functions return 'F on fail, but to make this mean fail I'm binding 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; it to NIL
+
-(F . NIL)
+((NIL)
-;; Binding all system functions to NIL so that you can see on the OBLIST that
+  (T . T)
-;; they exist.
+  (F)
-(ADD1 . NIL)
+  (ADD1)
-(AND . NIL)
+  (AND)
-(APPEND . NIL)
+  (APPEND)
-(APPLY . NIL)
+  (APPLY)
-(ATOM . NIL)
+  (ATOM)
-(CAR . NIL)
+  (CAR)
-(CDR . NIL)
+  (CDR)
-(CONS . NIL)
+  (CONS)
-(DEFINE . NIL)
+  (COPY LAMBDA (X) 
-(DIFFERENCE . NIL)
+    (COND ((NULL X) (QUOTE NIL)) 
-(EQ . NIL)
+      ((ATOM X) X) 
-(EQUAL . NIL)
+      ((QUOTE T) (CONS (COPY (CAR X)) (COPY (CDR X))))))
-(EVAL)
+  (DEFINE)
-(FIXP . NIL)
+  (DIFFERENCE)
-(INTEROP . NIL)
+  (DIVIDE LAMBDA (X Y) (CONS (QUOTIENT X Y) (CONS (REMAINDER X Y) (QUOTE NIL))))
-(NUMBERP . NIL)
+  (ERROR)
-(OBLIST . NIL)
+  (EQ)
-(PLUS . NIL)
+  (EQUAL)
-(PRETTY . NIL)
+  (EVAL)
-(QUOTIENT . NIL)
+  (FIXP)
-(READ . NIL)
+  (GENSYM)
-(REMAINDER)
+  (GET LAMBDA (X Y) 
-(RPLACA . NIL)
+    (COND ((NULL X) (QUOTE NIL)) 
-(RPLACD . NIL)
+      ((EQ (CAR X) Y) (CAR (CDR X))) 
-(SET . NIL)
+      ((QUOTE T) (GET (CDR X) Y))))
-(SYSIN . NIL)
+  (GREATERP)
-(SYSOUT . NIL)
+  (INTEROP)
-(TIMES . NIL)
+  (INTERSECTION 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) 
+    (COND ((NULL X) (QUOTE F)) 
+        ((EQ A (CAR X)) (QUOTE T)) 
+        ((QUOTE T) (MEMBER A (CDR X)))))
+  (MINUSP LAMBDA (X) (LESSP X 0))
+  (NULL LAMBDA (X) (COND ((EQUAL X NIL) (QUOTE T)) (T (QUOTE F))))
+  (NUMBERP)
+  (OBLIST)
+  (ONEP LAMBDA (X) (EQ X 1))
+  (PAIR LAMBDA (X Y) 
+    (COND ((AND (NULL X) (NULL Y)) NIL)
+        ((NULL X) (ERROR 'F2))
+        ((NULL Y) (ERROR 'F3))
+        (T (CONS (CONS (CAR X) (CAR Y)) (PAIR (CDR X) (CDR Y))))))
+  (PLUS)
+  (PRETTY)
+  (PRINT)
+  (PROP LAMBDA (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)
+    (COND ((EQ N 0) NIL)
+        (T (CONS X (REPEAT (SUB1 N) X)))))
+  (RPLACA) 
+  (RPLACD) 
+  (SET)
+  (SUB1 LAMBDA (N) (DIFFERENCE N 1)) 
+  (SYSIN) 
+  (SYSOUT) 
+  (TERPRI)
+  (TIMES)
+  (ZEROP LAMBDA (N) (EQ N 0)))

resources/mexpr/copy.mexpr.lsp

@@ -0,0 +1,3 @@
+copy[x] = [null[x] -> NIL; 
+    atom[x] -> x; 
+    T -> cons[ copy[ car[x]]; copy[ cdr[x]]]]

resources/mexpr/divide.mexpr.lsp

@@ -0,0 +1,3 @@
+;; page 26
+
+divide[x; y] = cons[ quotient[x; y]; cons[ remainder[x; y]; NIL]]

resources/mexpr/gcd.mexpr.lsp

@@ -2,4 +2,4 @@ gcd[x;y] = [x>y -> gcd[y;x];
             rem[y;x] = 0 -> x;
             T -> gcd[rem[y;x];x]]
 
-;; gcd[x;y] = [x>y -> gcd[y;x]; rem[y;x] = 0 -> x; T -> gcd[rem[y;x];x]]
+;; gcd[x;y] = [x>y -> gcd[y;x]; remainder[y;x] = 0 -> x; T -> gcd[remainder[y;x];x]]

resources/mexpr/get.mexpr.lsp

@@ -0,0 +1,6 @@
+;; page 59; slightly modified because I don't at this stage want to
+;; assume the existence of CADR
+
+get[x; y] = [null[x] -> NIL;
+    eq[car[x]; y] -> car[cdr[x]];
+    T -> get[cdr[x]; y]]

resources/mexpr/intersection.mexpr.lsp

@@ -0,0 +1,5 @@
+;; page 15
+
+intersection[x;y] = [null[x] -> NIL;
+    member[car[x]; y] -> cons[car[x]; intersection[cdr[x]; y]];
+    T -> intersection[cdr[x]; y]]

resources/mexpr/member.mexpr.lsp

@@ -0,0 +1,4 @@
+;; page 15
+member[a; x] = [null[x] -> F;
+    eq[a; car[x]] -> T;
+    T-> member[a; cdr[x]]]

resources/mexpr/null.mexpr.lsp

@@ -0,0 +1,7 @@
+null[x] = [x = NIL -> T; T -> F]
+
+(SETQ NULL 
+    '(LAMBDA (X)
+        (COND 
+            ((EQUAL X NIL) 'T) 
+            (T (QUOTE F)))))

resources/mexpr/prop.mexpr.lsp

@@ -0,0 +1,4 @@
+;; page 59
+prop[x;y;u] = [null[x] -> u[];
+    eq[car[x]; y] -> cdr[x];
+    T -> prop[cdr[x]; y; u]]

resources/mexpr/union.mexpr.lsp

@@ -0,0 +1,4 @@
+;; page 15
+union[x; y] = [null[x] -> y;
+    member[car[x]; y] -> union[cdr[x]; y];
+    T -> cons[car[x]; union[cdr[x]; y]]]

resources/null.mexpr.lsp

@@ -1 +0,0 @@
-null[x] = [x = NIL -> T; T -> F]

resources/sexpr/conc.lsp

@@ -0,0 +1 @@
+;; TODO

resources/sexpr/length.lsp

@@ -0,0 +1 @@
+(SETQ LENGTH '(LAMBDA (L) (COND ((EQ NIL L) 0) (T (ADD1 (LENGTH (CDR L)))))))

resources/sexpr/pair.lsp

@@ -0,0 +1,11 @@
+;; PAIR is defined on page 60 of the manual, but the definition depends on both
+;; PROG and GO, and I haven't got those working yet; so this is a pure 
+;; functional implementation.
+;; Return a list of pairs from lists `x` and `y`, required both to have the same
+;; length.
+
+(DEFUN PAIR (X Y) 
+    (COND ((AND (NULL X) (NULL Y)) NIL)
+        ((NULL X) (ERROR 'F2))
+        ((NULL Y) (ERROR 'F3))
+        (T (CONS (CONS (CAR X) (CAR Y)) (PAIR (CDR X) (CDR Y))))))

resources/sexpr/repeat.lsp

@@ -0,0 +1,6 @@
+;; REPEAT is not present in the Lisp 1.5 manual, but it's so simple and so
+;; useful that it seems a legitimate extension.
+
+(DEFUN REPEAT (N X)
+    (COND ((EQ N 0) NIL)
+        (T (CONS X (REPEAT (SUB1 N) X)))))

src/beowulf/bootstrap.clj

@@ -13,7 +13,8 @@
             [clojure.tools.trace :refer [deftrace]]
             [beowulf.cons-cell :refer [CAR CDR CONS LIST make-beowulf-list make-cons-cell
                                        pretty-print T F]]
-            [beowulf.host :refer [AND ADD1 DIFFERENCE FIXP NUMBERP PLUS QUOTIENT
+            [beowulf.host :refer [AND ADD1 DIFFERENCE ERROR FIXP GENSYM GREATERP LESSP 
+                                  NUMBERP PLUS QUOTIENT
                                   REMAINDER RPLACA RPLACD SUB1 TIMES]]
             [beowulf.io :refer [SYSIN SYSOUT]]
             [beowulf.oblist :refer [*options* oblist NIL]]
@@ -353,9 +354,11 @@
        :detail :strict}))))
 
 (defn OBLIST
-  "Not certain whether or not this is part of LISP 1.5; adapted from PSL. 
+  "Return a list of the symbols currently bound on the object list.
-  return the current value of the object list. Note that in PSL this function
+   
-  returns a list of the symbols bound, not the whole association 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."
   []
   (when (lax? 'OBLIST)
     (if (instance? ConsCell @oblist)
@@ -415,23 +418,33 @@
         DIFFERENCE (DIFFERENCE (CAR args) (CADR args))
         EQ (apply EQ args)
         EQUAL (apply EQUAL args)
+        ERROR (apply ERROR args)
         ;; think about EVAL. Getting the environment right is subtle
         FIXP (apply FIXP args)
+        GENSYM (GENSYM)
+        GREATERP (apply GREATERP args)
         INTEROP (when (lax? INTEROP) (apply INTEROP args))
+        LESSP (apply LESSP args)
         LIST (apply LIST args)
         NUMBERP (apply NUMBERP args)
         OBLIST (OBLIST)
         PLUS (apply PLUS args)
         PRETTY (when (lax? 'PRETTY)
                  (apply pretty-print args))
+        PRINT (apply print args)
         QUOTIENT (apply QUOTIENT args)
         READ (READ)
         REMAINDER (apply REMAINDER args)
         RPLACA (apply RPLACA args)
         RPLACD (apply RPLACD args)
         SET (apply SET args)
-        SYSIN (when (lax? 'SYSIN) (apply SYSIN args))
+        SYSIN (when (lax? 'SYSIN) 
-        SYSOUT (when (lax? 'SYSOUT) (apply SYSOUT args))
+                (apply SYSIN args))
+        SYSOUT (when (lax? 'SYSOUT)
+                 (if (empty? args)
+                   (SYSOUT)
+                   (apply SYSOUT args)))
+        TERPRI (println)
         TIMES (apply TIMES args)
         ;; else
         (ex-info "No function found"

src/beowulf/host.clj

@@ -2,7 +2,8 @@
   "provides Lisp 1.5 functions which can't be (or can't efficiently
    be) implemented in Lisp 1.5, which therefore need to be implemented in the
    host language, in this case Clojure."
-  (:require [beowulf.cons-cell :refer [F make-beowulf-list T]]
+  (:require [clojure.string :refer [upper-case]]
+            [beowulf.cons-cell :refer [F make-beowulf-list T]]
             ;; note hyphen - this is Clojure...
             [beowulf.oblist :refer [NIL]])
   (:import [beowulf.cons_cell ConsCell]
@@ -14,13 +15,13 @@
 ;; portability.
 
 (defn AND 
-  "True if and only if none of my `args` evaluate to either `F` or `NIL`,
+  "`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 %) (empty? %)) args))
+  (if (empty? (filter #(or (= 'F %) (= NIL %) (nil? %)) args))
     'T
     'F))
 
@@ -116,3 +117,22 @@
 (defn NUMBERP
   [x]
   (if (number? x) T F))
+
+(defn GENSYM
+  "Generate a unique symbol."
+  []
+  (symbol (upper-case (str (gensym "SYM")))))
+
+(defn ERROR
+  "Throw an error"
+  [& args]
+  (throw (ex-info "LISP ERROR" {:cause (apply vector args)
+                                :phase :eval})))
+
+(defn LESSP
+  [x y]
+  (< x y))
+
+(defn GREATERP
+  [x y]
+  (> x y))

src/beowulf/io.clj

@@ -83,4 +83,3 @@
                                         :filepath fp}
                                        any))))]
     (swap! oblist #(when (or % (seq content)) content))))
-

src/beowulf/read.clj

@@ -13,7 +13,8 @@
 
   Both these extensions can be disabled by using the `--strict` command line
   switch."
-  (:require [beowulf.reader.generate :refer [generate]]
+  (:require [beowulf.reader.char-reader :refer [read-chars]]
+            [beowulf.reader.generate :refer [generate]]
             [beowulf.reader.parser :refer [parse]]
             [beowulf.reader.simplify :refer [remove-optional-space simplify]]
             [clojure.string :refer [join split starts-with? trim]])
@@ -78,10 +79,10 @@
   the final Lisp reader. `input` should be either a string representation of a LISP
   expression, or else an input stream. A single form will be read."
   ([]
-   (gsp (read-from-console)))
+   (gsp (read-chars)))
   ([input]
    (cond
-     (empty? input) (gsp (read-from-console))
+     (empty? input) (READ)
      (string? input) (gsp input)
      (instance? InputStream input) (READ (slurp input))
      :else    (throw (ex-info "READ: `input` should be a string or an input stream" {})))))

src/beowulf/reader/char_reader.clj

@@ -0,0 +1,50 @@
+(ns beowulf.reader.char-reader
+  "Provide sensible line editing, auto completion, and history recall.
+   
+   None of what's needed here is really working yet, and a pull request with
+   a working implementation would be greatly welcomed.
+   
+   ## What's needed (rough specification)
+   
+   1. Carriage return **does not** cause input to be returned, **unless**
+       a. the number of open brackets `(` and closing brackets `)` match; and
+       b. the number of open square brackets `[` and closing square brackets `]` also match;
+   2. <Ctrl-D> aborts editing and returns the string `STOP`;
+   3. <Up-arrow> and <down-arrow> scroll back and forward through history, but ideally I'd like 
+      this to be the Lisp history (i.e. the history of S-Expressions actually read by `READ`, 
+      rather than the strings which were supplied to `READ`);
+   4. <Tab> offers potential auto-completions taken from the value of `(OBLIST)`, ideally the
+      current value, not the value at the time the session started;
+   5. <Back-arrow> and <Forward-arrow> offer movement and editing within the line."
+  (:import [org.jline.reader LineReader LineReaderBuilder]
+           [org.jline.terminal TerminalBuilder]))
+
+;; 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
+;; the time.
+
+(def get-reader
+  "Return a reader, first constructing it if necessary.
+   
+   **NOTE THAT** this is not settled API. The existence and call signature of
+   this function is not guaranteed in future versions."
+  (memoize (fn []
+  (let [term (.build (.system (TerminalBuilder/builder) true))]
+    (.build (.terminal (LineReaderBuilder/builder) term))))))
+
+(defn read-chars
+  "A drop-in replacement for `clojure.core/read-line`, except that line editing
+   and history should be enabled.
+   
+   **NOTE THAT** this does not work yet, but it is in the API because I hope 
+   that it will work later!"
+  [] 
+    (let [eddie (get-reader)]
+      (loop [s (.readLine eddie)]
+      (if (and (= (count (re-seq #"\(" s))
+           (count (re-seq #"\)" s)))
+               (= (count (re-seq #"\[]" s))
+                  (count (re-seq #"\]" s))))
+        s
+        (recur (str s " " (.readLine eddie)))))))

src/beowulf/reader/macros.clj

@@ -10,6 +10,9 @@
 ;; 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
+
 (def ^:dynamic *readmacros*
   {:car {'DEFUN (fn [f]
                   (LIST 'SET (LIST 'QUOTE (second f))

src/beowulf/reader/parser.clj

@@ -27,9 +27,9 @@
     "mexpr := λexpr | fncall | defn | cond | mvar | mconst | iexpr | number | mexpr comment;
       λexpr := λ lsqb bindings semi-colon body rsqb;
       λ := 'λ';
-      bindings := lsqb args rsqb;
+      bindings := lsqb args rsqb | lsqb rsqb;
       body := (mexpr semi-colon opt-space)* mexpr;
-      fncall := fn-name lsqb args rsqb;
+      fncall := fn-name bindings;
       lsqb := '[';
       rsqb := ']';
        lbrace := '{';
@@ -38,7 +38,7 @@
       cond := lsqb (opt-space cond-clause semi-colon opt-space)* cond-clause rsqb;
       cond-clause := mexpr opt-space arrow opt-space mexpr opt-space;
       arrow := '->';
-      args := (opt-space mexpr semi-colon opt-space)* mexpr;
+      args := mexpr | (opt-space mexpr semi-colon opt-space)* opt-space mexpr opt-space;
       fn-name := mvar;
       mvar := #'[a-z]+';
       mconst := #'[A-Z]+';
@@ -75,7 +75,7 @@
 
       ;; Lisp 1.5 supported octal as well as decimal and scientific notation
     "number := integer | decimal | scientific | octal;
-      integer := #'-?[1-9][0-9]*';
+      integer := #'-?[0-9]+';
       decimal := integer dot integer;
       scientific := coefficient e exponent;
       coefficient := decimal | integer;