From dc46735f5545bc68c3db274f0d902e9653be7728 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 4 Jul 2023 23:42:19 +0100 Subject: [PATCH] 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)))))