Merge remote-tracking branch 'origin/develop' into develop

.gitignore

@@ -21,3 +21,7 @@ Sysout*.lsp
 *.pdf
 
 src/beowulf/scratch.clj
+
+.portal/vs-code.edn
+
+.portal/

.portal/vs-code.edn

@@ -1 +0,0 @@
-{:host "localhost", :port 62056}

README.md

@@ -77,7 +77,7 @@ You are of course welcome to fork the project and do whatever you like with it!
 
 Invoke with
 
-    java -jar target/uberjar/beowulf-0.3.0-standalone.jar --help
+    java -jar target/uberjar/beowulf-0.3.1-standalone.jar --help
 
 (Obviously, check your version number)
 

doc/lisp1.5.md

@@ -961,19 +961,15 @@ But if eval is given (QUOTE X), X should not be evaluated. QUOTE is a special fo
 that prevents its argument from being evaluated.
 A special form differs from a function in two ways. Its arguments are not evaluated
 before the special form sees them. COND, for example, has a very special way of
-```
-
 evaluating its arguments by using evcon. The second way which special forms differ
-from functions is that they may have an indefinite number of arguments. Special forrrls
+from functions is that they may have an indefinite number of arguments. Special forms
 have indicators on their property lists called FEXPR and FSUBR for LISP-defined forms
 and machine language coded forms, respectively.
 
-```
+### 2.6 Programming for the Interpreter
-2.6 Programming for the Interpreter
-```
 
 The purpose of this section is to help the programmer avoid certain common errors.
-Example 1
+Example 1: CAR
 fn: CAR
 args: ((A B))
 The value is A. Note that the interpreter expects a list of arguments. The one argu-
@@ -981,13 +977,11 @@ ment for car is (A B). The extra pair of parentheses is necessary.
 One could write (LAMBDA (X) (CAR X)) instead of just CAR. This is correct but
 unnecessary.
 
-```
+Example 2: CONS
-Example 2
 fn: CONS
 args: (A (B . C))
-The value is cons[^;(^. c)] = (A. (B. C)).
+The value is cons[a; cons[b; c]] = (A . (B . C)).
 The print program will write this as (A B . C).
-```
 
 Example (^3) -
 fn: CONS

src/beowulf/bootstrap.clj

@@ -14,6 +14,7 @@
             [beowulf.host :refer [ASSOC ATOM CAAR CAADR CADAR CADDR CADR CAR CDR
                                   CONS ERROR GET LIST NUMBERP PAIRLIS traced?]]
             [beowulf.oblist :refer [*options* NIL]]
+            [clojure.string :as s]
             [clojure.tools.trace :refer [deftrace]])
   (:import [beowulf.cons_cell ConsCell]
            [clojure.lang Symbol]))
@@ -48,6 +49,10 @@
    functions which call EVAL/APPLY but do not know about depth."
   0)
 
+(defn- trace-indent
+  ([] (trace-indent *depth*))
+  ([d] (s/join (repeat d " "))))
+
 (def find-target
   (memoize
    (fn [target body]
@@ -102,10 +107,10 @@
                                                   vars env depth)]
                                          (when (traced? 'PROG)
                                            (println "  PROG:RETURN: Returning "
-                                                    val)
+                                                    val))
                                          (make-cons-cell
                                           '*PROGRETURN*
-                                            val)))
+                                          val))
                                 SET (let [var (prog-eval (CADR expr)
                                                          vars env depth)
                                           val (prog-eval (CADDR expr)
@@ -195,7 +200,7 @@
                   (println "Program:")
                   (pretty-print program))) ;; for debugging
     (loop [cursor body]
-      (let [step (.getCar cursor)]
+      (let [step (if (= NIL cursor) NIL (.getCar cursor))]
         (when trace (do (println "Executing step: " step)
                         (println "  with vars: " @vars)))
         (cond (= cursor NIL) NIL
@@ -228,7 +233,7 @@
   with these `args` at this depth."
   [function-symbol args depth]
   (when (traced? function-symbol)
-    (let [indent (apply str (repeat depth "-"))]
+    (let [indent (trace-indent depth)]
       (println (str indent "> " function-symbol " " args)))))
 
 (defn- trace-response
@@ -236,10 +241,12 @@
    `function-symbol` at this depth."
   [function-symbol response depth]
   (when (traced? function-symbol)
-    (let [indent (apply str (repeat depth "-"))]
+    (let [indent (apply str (trace-indent depth))]
       (println (str "<" indent " " function-symbol " " response))))
   response)
 
+;;;; Support functions for interpreter ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn value
   "Seek a value for this symbol `s` by checking each of these indicators in
    turn."
@@ -436,7 +443,7 @@
           (println (str indent ": EVAL: deóp bindele: (" expr " . " (or v' "nil") ")")))
         (if v'
           v'
-          (throw (ex-info "Ne tácen-bindele āfand"
+          (throw (ex-info (format "Ne tácen-bindele āfand: `%s`" expr)
                           {:phase :eval
                            :function 'EVAL
                            :args (list expr env depth)

test/beowulf/lisp_test.clj

@@ -7,7 +7,7 @@
             [beowulf.read :refer [READ]]
             [clojure.test :refer [deftest is testing use-fixtures]]))
 
-(defn- reps
+(defn reps
   "'Read eval print string', or 'read eval print single'.
    Reads and evaluates one input string, and returns the
    output string."
@@ -130,7 +130,6 @@
             actual (reps input)]
         (is (= actual expected))))))
 
-
 (deftest MEMBER-tests
   (testing "member"
     (let [expected "T"
@@ -147,17 +146,18 @@
       (is (= actual expected)))))
 
 ;; This is failing, and although yes, it does matter, I have not yet tracked the reason.
-;; (deftest sublis-tests
+(deftest sublis-tests
-;;   (testing "sublis"
+  (testing "sublis"
-;;     (let [expected "(SHAKESPEARE WROTE (THE TEMPEST))"
+    (let [expected "(SHAKESPEARE WROTE (THE TEMPEST))"
-;;           actual (reps
+          actual (reps
-;;                    "(SUBLIS
+                   "(SUBLIS
-;;                      '((X . SHAKESPEARE) (Y . (THE TEMPEST)))
+                     '((X . SHAKESPEARE) (Y . (THE TEMPEST)))
-;;                      '(X WROTE Y))")]
+                     '(X WROTE Y))")]
-;;       (is (= actual expected)))))
+      (is (= actual expected)))))
 
 (deftest prog-tests
   (testing "PROG"
+    ;; (reps "(TRACE 'PROG)")
     (let [expected "5"
           actual (reps "(PROG (X)
     (SETQ X 1)
@@ -209,7 +209,17 @@
     (reps "(SETQ P (RANGE 1 4))")
     (reps "(SETQ Q (RANGE 5 8))")
     (reps "(SETQ R (RANGE 9 12))") 
-    (reps "(CONC P Q R)")
     (let [expected "(1 2 3 4 5 6 7 8 9 10 11 12)"
+          actual (reps "(CONC P Q R)")]
+      (is (= actual expected)))))
+
+(deftest attrib-tests
+  (testing "ATTRIB"
+    (reps "(SETQ X '(A B C))")
+    (reps "(SETQ Y '(D E F))")
+    (let [expected "(D E F)"
+          actual (reps "(ATTRIB X Y)")]
+      (is (= actual expected)))
+    (let [expected "(A B C D E F)"
           actual (reps "X")]
       (is (= actual expected)))))