simon/beowulf
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Fixed the bug in PROG!

Browse source
This commit is contained in:
Simon Brooke 2023-07-04 23:42:19 +01:00
parent 33079232e1
commit dc46735f55
5 changed files with 37 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

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

2
README.md
View file

@ -77,7 +77,7 @@ You are of course welcome to fork the project and do whatever you like with it!
Invoke with 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) (Obviously, check your version number)

30
doc/lisp1.5.md
View file

@ -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. that prevents its argument from being evaluated.
A special form differs from a function in two ways. Its arguments are not 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 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 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 have indicators on their property lists called FEXPR and FSUBR for LISP-defined forms
and machine language coded forms, respectively. 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. The purpose of this section is to help the programmer avoid certain common errors.
Example 1 Example 1: CAR
fn: CAR fn: CAR
args: ((A B)) args: ((A B))
The value is A. Note that the interpreter expects a list of arguments. The one argu- 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 One could write (LAMBDA (X) (CAR X)) instead of just CAR. This is correct but
unnecessary. unnecessary.
``` Example 2: CONS
Example 2
fn: CONS fn: CONS
args: (A (B. C)) 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). The print program will write this as (A B . C).
```
Example (^3) - Example (^3) -
fn: CONS fn: CONS
args: ((CAR (QUOTE (A. B))) (CDR (QUOTE (C. D)))) args: ((CAR (QUOTE (A . B))) (CDR (QUOTE (C . D))))
The value of this computation will be ((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 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. 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 * 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 -- that will evaluate to the arguments. Tworcorrect ways of writing this function are listed

25
src/beowulf/bootstrap.clj
View file

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

10
test/beowulf/lisp_test.clj
View file

@ -7,7 +7,7 @@
[beowulf.read :refer [READ]] [beowulf.read :refer [READ]]
[clojure.test :refer [deftest is testing use-fixtures]])) [clojure.test :refer [deftest is testing use-fixtures]]))
(defn- reps (defn reps
"'Read eval print string', or 'read eval print single'. "'Read eval print string', or 'read eval print single'.
Reads and evaluates one input string, and returns the Reads and evaluates one input string, and returns the
output string." output string."
@ -156,8 +156,11 @@
;; '(X WROTE Y))")] ;; '(X WROTE Y))")]
;; (is (= actual expected))))) ;; (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 (deftest prog-tests
(testing "PROG" (testing "PROG"
;; (reps "(TRACE 'PROG)")
(let [expected "5" (let [expected "5"
actual (reps "(PROG (X) actual (reps "(PROG (X)
(SETQ X 1) (SETQ X 1)
@ -208,8 +211,7 @@
(testing "FSUBR/CONC" (testing "FSUBR/CONC"
(reps "(SETQ P (RANGE 1 4))") (reps "(SETQ P (RANGE 1 4))")
(reps "(SETQ Q (RANGE 5 8))") (reps "(SETQ Q (RANGE 5 8))")
(reps "(SETQ R (RANGE 9 12))") (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)" (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))))) (is (= actual expected)))))