From dc46735f5545bc68c3db274f0d902e9653be7728 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 4 Jul 2023 23:42:19 +0100 Subject: [PATCH 1/2] Fixed the bug in PROG! --- .gitignore | 2 ++ README.md | 2 +- doc/lisp1.5.md | 30 ++++++++++++------------------ src/beowulf/bootstrap.clj | 25 ++++++++++++++++--------- test/beowulf/lisp_test.clj | 10 ++++++---- 5 files changed, 37 insertions(+), 32 deletions(-) diff --git a/.gitignore b/.gitignore index a0db7e2..fc2a440 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,5 @@ Sysout*.lsp *.pdf src/beowulf/scratch.clj + +.portal/vs-code.edn diff --git a/README.md b/README.md index 364cfe3..c20c17c 100644 --- a/README.md +++ b/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) diff --git a/doc/lisp1.5.md b/doc/lisp1.5.md index 11fe6db..4a566ed 100644 --- a/doc/lisp1.5.md +++ b/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 -have indicators on their property lists called FEXPR and FSUBR for LISP -defined forms +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,20 +977,18 @@ 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 +Example 2: CONS fn: CONS -args: (A (B. C)) -The value is cons[^;(^. c)] = (A. (B. C)). -The print program will write this as (A B. C). -``` +args: (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 -args: ((CAR (QUOTE (A. B))) (CDR (QUOTE (C. D)))) -The value of this computation will be ((CAR (QUOTE (A. B))). (CDR (QUOTE (C. D)))). -This is not what the programmer expected. He expected (CAR (QUOTE (A. B))) to -evaluate to A, and expected (A. D) as the value of cons. +args: ((CAR (QUOTE (A . B))) (CDR (QUOTE (C . D)))) +The value of this computation will be ((CAR (QUOTE (A . B))) . (CDR (QUOTE (C . D)))). +This is not what the programmer expected. He expected (CAR (QUOTE (A . B))) to +evaluate to A, and expected (A . D) as the value of cons. * The interpreter expects a ---- list of arguments. ------- It does not expect a list of expressions -- that will evaluate to the arguments. Tworcorrect ways of writing this function are listed diff --git a/src/beowulf/bootstrap.clj b/src/beowulf/bootstrap.clj index 786908b..f20837d 100644 --- a/src/beowulf/bootstrap.clj +++ b/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] @@ -101,17 +106,17 @@ (CADR expr) vars env depth)] (when (traced? 'PROG) - (println " PROG:RETURN: Returning " - val) - (make-cons-cell - '*PROGRETURN* - val))) + (println " PROG:RETURN: Returning " + val)) + (make-cons-cell + '*PROGRETURN* + val)) SET (let [var (prog-eval (CADR expr) vars env depth) val (prog-eval (CADDR expr) vars env depth)] (when (traced? 'PROG) - (println " PROG:SET: Setting " + (println " PROG:SET: Setting " var " to " val)) (swap! vars assoc @@ -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." diff --git a/test/beowulf/lisp_test.clj b/test/beowulf/lisp_test.clj index b89fe1a..e50f6c9 100644 --- a/test/beowulf/lisp_test.clj +++ b/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." @@ -156,8 +156,11 @@ ;; '(X WROTE Y))")] ;; (is (= actual expected))))) +;; this works just fine in the REPL provided PROG is traced, but does not work +;; if PROG is not traced (and doesn't work in the test harness either way) (deftest prog-tests (testing "PROG" + ;; (reps "(TRACE 'PROG)") (let [expected "5" actual (reps "(PROG (X) (SETQ X 1) @@ -208,8 +211,7 @@ (testing "FSUBR/CONC" (reps "(SETQ P (RANGE 1 4))") (reps "(SETQ Q (RANGE 5 8))") - (reps "(SETQ R (RANGE 9 12))") - (reps "(CONC P Q R)") + (reps "(SETQ R (RANGE 9 12))") (let [expected "(1 2 3 4 5 6 7 8 9 10 11 12)" - actual (reps "X")] + actual (reps "(CONC P Q R)")] (is (= actual expected))))) From 9899a8b678f834e7d0ccf626d2c75ee50cd09653 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 5 Jul 2023 08:12:27 +0100 Subject: [PATCH 2/2] SUBLIS test still breaking, CONC test still failing, otherwise good. I'm now convinced that the reason for the SUBLIS fail is a misprint in the manual! --- .gitignore | 2 ++ .portal/vs-code.edn | 1 - src/beowulf/bootstrap.clj | 2 +- test/beowulf/lisp_test.clj | 30 +++++++++++++++++++----------- 4 files changed, 22 insertions(+), 13 deletions(-) delete mode 100644 .portal/vs-code.edn diff --git a/.gitignore b/.gitignore index fc2a440..795f8a4 100644 --- a/.gitignore +++ b/.gitignore @@ -23,3 +23,5 @@ Sysout*.lsp src/beowulf/scratch.clj .portal/vs-code.edn + +.portal/ diff --git a/.portal/vs-code.edn b/.portal/vs-code.edn deleted file mode 100644 index fde814a..0000000 --- a/.portal/vs-code.edn +++ /dev/null @@ -1 +0,0 @@ -{:host "localhost", :port 62056} \ No newline at end of file diff --git a/src/beowulf/bootstrap.clj b/src/beowulf/bootstrap.clj index f20837d..7f4ed1a 100644 --- a/src/beowulf/bootstrap.clj +++ b/src/beowulf/bootstrap.clj @@ -443,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) diff --git a/test/beowulf/lisp_test.clj b/test/beowulf/lisp_test.clj index e50f6c9..98bcc39 100644 --- a/test/beowulf/lisp_test.clj +++ b/test/beowulf/lisp_test.clj @@ -130,7 +130,6 @@ actual (reps input)] (is (= actual expected)))))) - (deftest MEMBER-tests (testing "member" (let [expected "T" @@ -147,17 +146,15 @@ (is (= actual expected))))) ;; This is failing, and although yes, it does matter, I have not yet tracked the reason. -;; (deftest sublis-tests -;; (testing "sublis" -;; (let [expected "(SHAKESPEARE WROTE (THE TEMPEST))" -;; actual (reps -;; "(SUBLIS -;; '((X . SHAKESPEARE) (Y . (THE TEMPEST))) -;; '(X WROTE Y))")] -;; (is (= actual expected))))) +(deftest sublis-tests + (testing "sublis" + (let [expected "(SHAKESPEARE WROTE (THE TEMPEST))" + actual (reps + "(SUBLIS + '((X . SHAKESPEARE) (Y . (THE TEMPEST))) + '(X WROTE Y))")] + (is (= actual expected))))) -;; this works just fine in the REPL provided PROG is traced, but does not work -;; if PROG is not traced (and doesn't work in the test harness either way) (deftest prog-tests (testing "PROG" ;; (reps "(TRACE 'PROG)") @@ -215,3 +212,14 @@ (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))))) \ No newline at end of file