All ready to implement property lists, not yet done.

README.md

@@ -39,6 +39,10 @@ Command line arguments as follows:
 
 To end a session, type `STOP` at the command prompt.
 
+### Reader macros
+
+Currently I don't have 
+
 ### Functions and symbols implemented
 
 The following functions and symbols are implemented:

doc/values.md

@@ -0,0 +1,35 @@
+# Understanding values and properties
+
+I had had the naive assumption that entries on the object list had their CAR pointing to the symbol and their CDR pointing to the related value. Consequently, I could not work out where the property list went. More careful reading of the
+text implies, but does not explicitly state, that my naive assumption is wrong.
+
+Instead, it appears that the `CAR` points to the symbol, as expected, but the `CAR` points to the property list; and that on the property list there are privileged properties at least as follows:
+
+APVAL
+: the simple straightforward ordinary value of the symbol, considered a variable;
+EXPR
+: the definition of the function considered as a normal lambda expression (arguments to be evaluated before applying);
+FEXPR
+: the definition of a function which should be applied to unevaluated arguments;
+SUBR
+: the definition of a complied subroutine which should be applied to evaluated arguments;
+FSUBR
+: the definition of a complied subroutine which should be applied to unevaluated arguments;
+
+I think there was also another privileged property value which contained the property considered as a constant, but I haven't yet confirmed that.
+
+From this it would seem that Lisp 1.5 was not merely a ['Lisp 2'](http://xahlee.info/emacs/emacs/lisp1_vs_lisp2.html) but in fact a 'Lisp 6', with six effectively first class namespaces. In fact it's not as bad as that, because of the way [`EVAL`](https://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf#page=79) is evaluated.
+
+Essentially the properties are tried in turn, and only the first value found is used. Thus the heirarchy is
+
+1. APVAL
+2. EXPR
+3. FEXPR
+4. SUBR
+5. FSUBR
+
+This means that, while the other potential values can be retrieved from the property list, interpreted definitions (if present) will always be preferred to uninterpreted definitions, and lambda function definitions (which evaluate their arguments), where present, will always be preferred to non-lamda definitions, which don't.
+
+**BUT NOTE THAT** the `APVAL` value is saught only when seeking a variable value for the symbol, and the others only when seeking a function value, so Lisp 1.5 is a 'Lisp 2', not a 'Lisp 1'.
+
+Versions of Beowulf up to and including 0.2.1 used the naive understanding of the architecture; version 0.3.0 *should* use the corrected version.

resources/lisp1.5.lsp

@@ -14,7 +14,7 @@
   (ASSOC LAMBDA (X L) 
     (COND 
       ((NULL L) (QUOTE NIL)) 
-      ((AND (CONSP (CAR L)) (EQ (CAAR L) X)) (CDAR L)) 
+      ((AND (CONSP (CAR L)) (EQ (CAAR L) X)) (CAR L)) 
       ((QUOTE T) (ASSOC X (CDR L)))))
   (ATOM)
   (CAR)
@@ -110,6 +110,10 @@
       ((NULL X) (ERROR (QUOTE F2)))
       ((NULL Y) (ERROR (QUOTE F3)))
       (T (CONS (CONS (CAR X) (CAR Y)) (PAIR (CDR X) (CDR Y))))))
+  (PAIRLIS LAMBDA (X Y A) 
+    (COND 
+      ((NULL X) A) 
+      ((QUOTE T) (CONS (CONS (CAR X) (CAR Y)) (PAIRLIS (CDR X) (CDR Y) A)))))
   (PLUS)
   (PRETTY)
   (PRINT)
@@ -118,6 +122,7 @@
     (X Y U)
     (COND
       ((NULL X) (U)) ((EQ (CAR X) Y) (CDR X)) ((QUOTE T) (PROP (CDR X) Y U))))
+  (QUOTE LAMBDA (X) X)
   (QUOTIENT)
   (RANGE LAMBDA (N M) (COND ((LESSP M N) (QUOTE NIL)) ((QUOTE T) (CONS N (RANGE (ADD1 N) M)))))
   (READ)
@@ -128,5 +133,16 @@
   (RPLACD)
   (SET)
   (SUB1 LAMBDA (N) (DIFFERENCE N 1))
+  (SUB2 LAMBDA (A Z) 
+    (COND 
+      ((NULL A) Z) 
+      ((EQ (CAAR A) Z) (CDAR A)) 
+      ((QUOTE T) (SUB2 (CDAR A) Z))))
+  (SUBLIS LAMBDA (A Y) (COND ((ATOM Y) (SUB2 A Y)) ((QUOTE T) (CONS))))
+  (SUBST LAMBDA (X Y Z) 
+    (COND 
+      ((EQUAL Y Z) X) 
+      ((ATOM Z) Z) 
+      ((QUOTE T) (CONS (SUBST X Y (CAR Z)) (SUBST X Y (CDR Z))))))
   (SYSIN)
   (SYSOUT) (TERPRI) (TIMES) (TRACE) (UNTRACE) (ZEROP LAMBDA (N) (EQ N 0)))

resources/mexpr/apply-2.mexpr.lsp

@@ -1,21 +0,0 @@
-;; see page 70 of Lisp 1.5 Programmers Manual; this expands somewhat 
-;; on the accounts of eval and apply given on page 13. This is M-expr
-;; syntax, obviously. 
-
-;; apply
-;; NOTE THAT I suspect there is a typo in the printed manual in line
-;; 7 of this definition, namely a missing closing square bracket before
-;; the final semi-colon; that has been corrected here.
-
-apply[fn;args;a] = [
-    null[fn] -> NIL;
-    atom[fn] -> [get[fn;EXPR] -> apply[expr; args; a];
-                 get[fn;SUBR] -> {spread[args];
-                                  $ALIST := a;
-                                  TSX subr4, 4};
-                 T -> apply[cdr[sassoc[fn; a; λ[[]; error[A2]]]]; args a]];
-    eq[car[fn]; LABEL] -> apply[caddr[fn]; args; 
-                                cons[cons[cadr[fn];caddr[fn]]; a]];
-    eq[car[fn]; FUNARG] -> apply[cadr[fn]; args; caddr[fn]];
-    eq[car[fn]; LAMBDA] -> eval[caddr[fn]; nconc[pair[cadr[fn]; args]; a]];
-    T -> apply[eval[fn;a]; args; a]]

resources/mexpr/apply.mexpr.lsp

@@ -0,0 +1,40 @@
+;; see page 70 of Lisp 1.5 Programmers Manual; this expands somewhat 
+;; on the accounts of eval and apply given on page 13. This is M-expr
+;; syntax, obviously. 
+
+;; ## APPLY
+
+;; NOTE THAT I suspect there is a typo in the printed manual in line
+;; 7 of this definition, namely a missing closing square bracket before
+;; the final semi-colon; that has been corrected here. 
+
+;; RIGHT! So the 'EXPR' representation of a function is expected to be
+;; on the `EXPR` property on the property list of the symbol which is 
+;; its name; an expression is simply a Lisp S-Expression as a structure
+;; of cons cells and atoms in memory. The 'SUBR' representation, expected
+;; to be on the `SUBR` property, is literally a subroutine written in 
+;; assembly code, so what is happening in the curly braces is putting the
+;; arguments into processor registers prior to a jump to subroutine - TSX
+;; being presumably equivalent to a 6502's JSR call.
+
+;; This accounts for the difference between this statement and the version
+;; on page 12: that is a pure interpreter, which can only call those host 
+;; functions that are explicitly hard coded in.
+
+;; This version knows how to recognise subroutines and jump to them, but I 
+;; think that by implication at least this version can only work if it is
+;; itself compiled with the Lisp compiler, since the section in curly braces
+;; appears to be intended to be passed to the Lisp assembler.
+
+;; apply[fn;args;a] = [
+;;     null[fn] -> NIL;
+;;     atom[fn] -> [get[fn;EXPR] -> apply[expr; args; a];
+;;                  get[fn;SUBR] -> {spread[args];
+;;                                   $ALIST := a;
+;;                                   TSX subr4, 4};
+;;                  T -> apply[cdr[sassoc[fn; a; λ[[]; error[A2]]]]; args a]];
+;;     eq[car[fn]; LABEL] -> apply[caddr[fn]; args; 
+;;                                 cons[cons[cadr[fn];caddr[fn]]; a]];
+;;     eq[car[fn]; FUNARG] -> apply[cadr[fn]; args; caddr[fn]];
+;;     eq[car[fn]; LAMBDA] -> eval[caddr[fn]; nconc[pair[cadr[fn]; args]; a]];
+;;     T -> apply[eval[fn;a]; args; a]]

resources/mexpr/assoc.mexpr.lsp

@@ -1,7 +1,22 @@
-;; Not present in Lisp 1.5(!)
+;; Page 12 of the manual; this does NOT do what I expect a modern
+;; ASSOC to do!
+
+;; Modern ASSOC would be:
+;; assoc[x; l] = [null[l] -> NIL;
+;;            and[consp[car[l]]; eq[caar[l]; x]] -> cdar[l];
+;;            T -> assoc[x; cdr[l]]]
+
+;; In the Lisp 1.5 statement of ASSOC, there's no account of what should happen
+;; if the key (here `x`) is not present on the association list `a`. It seems 
+;; inevitable that this causes an infinite run up the stack until it fails with
+;; stack exhaustion. Consequently this may be right but I'm not implementing it!
+;; assoc[x; a] = [equal[caar[a]; x] -> car[a];
+;;            T -> assoc[x; cdr[a]]]
+
+;; Consequently, my solution is a hybrid. It returns the pair from the 
+;; association list, as the original does, but it traps the end of list
+;; condition, as a modern solution would.
 
 assoc[x; l] = [null[l] -> NIL;
-            and[consp[car[l]]; eq[caar[l]; x]] -> cdar[l];
+            and[consp[car[l]]; eq[caar[l]; x]] -> car[l];
             T -> assoc[x; cdr[l]]]
-
-;; (ASSOC 'C (PAIR '(A B C D E F) (RANGE 1 6)))

resources/mexpr/pairlis.mexpr.lsp

@@ -0,0 +1,5 @@
+;; page 12
+
+pairlis[x;y;a] = [null[x] -> a;
+                T -> cons[cons[car[x]; car[y]];
+                        pairlis[cdr[x]; cdr[y]; a]]]

resources/mexpr/sublis.mexpr.lsp

@@ -0,0 +1,10 @@
+;; There are two different statements of SUBLIS and SUB2 in the manual, on 
+;; pages 12 and 61 respectively, although they are said to be semantically
+;; equivalent; this is the version from page 12. 
+
+sub2[a; z] = [null[a] -> z;
+            eq[caar[a]; z] -> cdar[a];
+            T -> sub2[cdar[a]; z]]
+
+sublis[a; y] = [atom[y] -> sub2[a; y];
+                T -> cons[]]

resources/mexpr/subst.mexpr.lsp

@@ -0,0 +1,5 @@
+;; page 11
+
+subst[x; y; z] = [equal[y; z] -> x;
+                atom[z] -> z;
+                T -> cons[subst[x; y; car[z]]; subst[x; y; cdr[z]]]]

src/beowulf/bootstrap.clj

@@ -14,8 +14,9 @@
                                        pretty-print T F]]
             [beowulf.host :refer [ADD1 AND ASSOC ATOM ATOM? CAR CDR CONS DEFINE
                                   DIFFERENCE DOC EQ EQUAL ERROR FIXP GENSYM
-                                  GREATERP lax? LESSP LIST NUMBERP OBLIST
+                                  GREATERP lax? LESSP LIST NUMBERP OBLIST PAIRLIS
-                                  PAIRLIS PLUS QUOTIENT REMAINDER RPLACA RPLACD SET 
+                                  PLUS
+                                  QUOTIENT REMAINDER RPLACA RPLACD SET
                                   TIMES TRACE traced? UNTRACE]]
             [beowulf.io :refer [SYSIN SYSOUT]]
             [beowulf.oblist :refer [*options* oblist NIL]]
@@ -249,7 +250,7 @@
         (case function-symbol ;; there must be a better way of doing this!
           ADD1 (safe-apply ADD1 args)
           AND (safe-apply AND args)
-          APPLY (APPLY (first args) (rest args) environment depth) ;; TODO: need to pass the environment and depth
+          APPLY (APPLY (first args) (rest args) environment depth)
           ATOM (ATOM? (CAR args))
           CAR (safe-apply CAR args)
           CDR (safe-apply CDR args)
@@ -309,10 +310,8 @@
                                         :function "NIL"
                                         :args args})))
     (= (ATOM? function) T) (apply-symbolic function args environment (inc depth))
-    (= (first function) 'LAMBDA) (EVAL
+    :else (case (first function)
-                                  (CADDR function)
+            LABEL (APPLY
-                                  (PAIRLIS (CADR function) args environment) depth)
-    (= (first function) 'LABEL) (APPLY
                    (CADDR function)
                    args
                    (make-cons-cell
@@ -320,7 +319,16 @@
                      (CADR function)
                      (CADDR function))
                     environment)
-                                 depth)))
+                   depth)
+            FUNARG (APPLY (CADR function) args (CADDR function) depth)
+            LAMBDA (EVAL
+                    (CADDR function)
+                    (PAIRLIS (CADR function) args environment) depth)
+            (throw (ex-info "Unrecognised value in function position"
+                            {:phase :apply
+                             :function function
+                             :args args
+                             :type :beowulf})))))
 
 (defn- EVCON
   "Inner guts of primitive COND. All `clauses` are assumed to be
@@ -379,10 +387,12 @@
                       (symbol expr))
      (=
       (ATOM? (CAR expr))
-      T) (cond
+      T) (case (CAR expr)
-           (= (CAR expr) 'QUOTE) (CADR expr)
+           QUOTE (CADR expr)
-           (= (CAR expr) 'COND) (EVCON (CDR expr) env depth)
+           FUNCTION (LIST 'FUNARG (CADR expr) )
-           :else (APPLY
+           COND (EVCON (CDR expr) env depth)
+           ;; else 
+           (APPLY
             (CAR expr)
             (EVLIS (CDR expr) env depth)
             env

src/beowulf/cons_cell.clj

@@ -205,9 +205,9 @@
 
 (defn pretty-print
   "This isn't the world's best pretty printer but it sort of works."
-  ([^beowulf.cons_cell.ConsCell cell]
+  ([cell]
    (println (pretty-print cell 80 0)))
-  ([^beowulf.cons_cell.ConsCell cell width level]
+  ([cell width level]
    (loop [c cell
           n (inc level)
           s "("]
@@ -215,7 +215,7 @@
       (instance? beowulf.cons_cell.ConsCell c)
        (let [car (.first c)
              cdr (.getCdr c)
-             cons? (instance? beowulf.cons_cell.ConsCell cdr)
+             tail? (instance? beowulf.cons_cell.ConsCell cdr)
              print-width (count (print-str c))
              indent (apply str (repeat n "  "))
              ss (str
@@ -224,7 +224,7 @@
                  (cond
                    (or (nil? cdr) (= cdr NIL))
                    ")"
-                   cons?
+                   tail?
                    (if
                     (< (+ (count indent) print-width) width)
                      " "
@@ -232,7 +232,7 @@
                    :else
                    (str " . " (pretty-print cdr width n) ")")))]
          (if
-          cons?
+          tail?
            (recur cdr n ss)
            ss))
        (str c)))))
@@ -258,6 +258,7 @@
   (try
     (cond
       (empty? x) NIL
+      (instance? ConsCell x) (make-cons-cell (.getCar x) (.getCdr x))
       (coll? x) (ConsCell.
                  (if
                   (coll? (first x))

src/beowulf/host.clj

@@ -269,12 +269,15 @@
 ;; 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
+  "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
+  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."
+  See page 12 of the Lisp 1.5 Programmers Manual.
+   
+   **NOTE THAT** this function is overridden by an implementation in Lisp,
+   but is currently still present for bootstrapping."
   [x a]
   (cond
     (= NIL a) NIL ;; this clause is not present in the original but is added for
@@ -283,43 +286,6 @@
     :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
@@ -330,7 +296,10 @@
   binding.
 
   All args are assumed to be `beowulf.cons-cell/ConsCell` objects.
-  See page 12 of the Lisp 1.5 Programmers Manual."
+  See page 12 of the Lisp 1.5 Programmers Manual.
+   
+   **NOTE THAT** this function is overridden by an implementation in Lisp,
+   but is currently still present for bootstrapping."
   [x y a]
   (cond
     ;; the original tests only x; testing y as well will be a little more
@@ -452,9 +421,11 @@
   (when
    (swap!
     oblist
-    (fn [ob s v] (make-cons-cell (make-cons-cell s v) ob))
+    (fn [ob s v] (if-let [binding (ASSOC symbol ob)]
+                   (RPLACD binding v)
+                   (make-cons-cell (make-cons-cell s v) ob)))
     symbol val)
-    NIL))
+    val))
 
 ;;;; TRACE and friends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

src/beowulf/reader/generate.clj

@@ -243,6 +243,7 @@
          :scientific (let [n (generate (second p))
                            exponent (generate (nth p 3))]
                        (* n (expt 10 exponent)))
+         :subr (symbol (second p))
 
       ;; default
          (throw (ex-info (str "Unrecognised head: " (first p))

src/beowulf/reader/macros.clj

@@ -48,7 +48,7 @@
   {:car {'DEFUN (fn [f]
                   (LIST 'SET (LIST 'QUOTE (second f))
                         (LIST 'QUOTE (CONS 'LAMBDA (rest (rest f))))))
-         'SETQ (fn [f] (LIST 'SET (LIST 'QUOTE (second f)) (LIST 'QUOTE (nth f 2))))}})
+         'SETQ (fn [f] (LIST 'SET (LIST 'QUOTE (second f)) (nth f 2)))}})
 
 (defn expand-macros
   [form]

src/beowulf/reader/parser.clj

@@ -78,7 +78,7 @@
 
       ;; sexprs. Note it's not clear to me whether Lisp 1.5 had the quote macro,
       ;; but I've included it on the basis that it can do little harm.
-    "sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment;
+    "sexpr := quoted-expr | atom | number | subr | dotted-pair | list | sexpr comment;
       list := lpar sexpr rpar | lpar (sexpr sep)* rpar | lpar (sexpr sep)* dot-terminal | lbrace exprs rbrace;
       list := lpar opt-space sexpr rpar | lpar opt-space (sexpr sep)* rpar | lpar opt-space (sexpr sep)* dot-terminal;
       dotted-pair := lpar dot-terminal ;
@@ -93,6 +93,12 @@
       sep := ',' | opt-space;
       atom := #'[A-Z][A-Z0-9]*';"
     
+    ;; we need a way of representing Clojure functions on the object list;
+    ;; subr objects aren't expected to be normally entered on the REPL, but
+    ;; must be on the object list or functions to which functions are passed
+    ;; won't be able to access them.
+    "subr := #'[a-z][a-z.]*/[A-Za-z][A-Za-z0-9]*';"
+
       ;; Lisp 1.5 supported octal as well as decimal and scientific notation
     "number := integer | decimal | scientific | octal;
       integer := #'-?[0-9]+';

test/beowulf/bootstrap_test.clj

@@ -3,7 +3,7 @@
             [beowulf.cons-cell :refer [make-cons-cell T F]]
             [beowulf.host :refer [ASSOC ATOM ATOM? CAR CAAAAR CADR
                                        CADDR CADDDR CDR EQ EQUAL 
-                                       PAIRLIS SUBLIS SUBST]]
+                                       PAIRLIS]]
             [beowulf.oblist :refer [NIL]]
             [beowulf.read :refer [gsp]]))
 
@@ -153,17 +153,18 @@
           actual (EQUAL l m)]
       (is (= actual expected) "different lists, different content"))))
 
-(deftest substitution-tests
+;; TODO: need to reimplement this in lisp_test
-  (testing "subst"
+;; (deftest substitution-tests
-    (let [expected "((A X . A) . C)"
+;;   (testing "subst"
-          ;; differs from example in book only because of how the function
+;;     (let [expected "((A X . A) . C)"
-          ;; `beowulf.cons-cell/to-string` formats lists.
+;;           ;; differs from example in book only because of how the function
-          actual (print-str
+;;           ;; `beowulf.cons-cell/to-string` formats lists.
-                   (SUBST
+;;           actual (print-str
-                     (gsp "(X . A)")
+;;                    (SUBST
-                     (gsp "B")
+;;                      (gsp "(X . A)")
-                     (gsp "((A . B) . C)")))]
+;;                      (gsp "B")
-      (is (= actual expected)))))
+;;                      (gsp "((A . B) . C)")))]
+;;       (is (= actual expected)))))
 
 (deftest pairlis-tests
   (testing "pairlis"
@@ -196,11 +197,12 @@
                      (gsp "((A . (M N)) (B . (CAR X)) (C . (QUOTE M)) (C . (CDR X)))")))]
       (is (= actual expected)))))
 
-(deftest sublis-tests
+;; TODO: need to reimplement this in lisp_test
-  (testing "sublis"
+;; (deftest sublis-tests
-    (let [expected "(SHAKESPEARE WROTE (THE TEMPEST))"
+;;   (testing "sublis"
-          actual (print-str
+;;     (let [expected "(SHAKESPEARE WROTE (THE TEMPEST))"
-                   (SUBLIS
+;;           actual (print-str
-                     (gsp "((X . SHAKESPEARE) (Y . (THE TEMPEST)))")
+;;                    (SUBLIS
-                     (gsp "(X WROTE Y)")))]
+;;                      (gsp "((X . SHAKESPEARE) (Y . (THE TEMPEST)))")
-      (is (= actual expected)))))
+;;                      (gsp "(X WROTE Y)")))]
+;;       (is (= actual expected)))))