Fixed the bug in PROG!

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

2
.gitignore vendored
View file

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

View file

@ -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)

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.
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

View file

@ -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."

View file

@ -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)))))