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

Struggling to get Lisp tests working; total fail, but improvements.

Browse source
This commit is contained in:
Simon Brooke 2023-03-31 00:49:33 +01:00
parent b6f52cd775
commit 03ed76f34d
9 changed files with 132 additions and 77 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -16,3 +16,4 @@ pom.xml.asc
.clj-kondo/
.lsp/
resources/scratch.lsp
Sysout*.lsp

2
CHANGELOG.md
View file

@ -1,7 +1,7 @@
# Change Log
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
## [0.2.1] - 2023-03-??
## [0.2.1] - 2023-03-30
### Changed
- this is fundamentally a working Lisp. The reader reads S-Expressions fully and M-Expressions at least partially. It is not (yet) a feature complete Lisp 1.5.

10
README.md
View file

@ -15,8 +15,6 @@ Boots to REPL, but few functions yet available.
* [Project website](https://simon-brooke.github.io/beowulf/).
* [Source code documentation](https://simon-brooke.github.io/beowulf/docs/codox/index.html).
* [Test Coverage Report](https://simon-brooke.github.io/beowulf/docs/cloverage/index.html)
### Building and Invoking
@ -101,6 +99,14 @@ The following functions and symbols are implemented:
| UNTRACE | ? | null | ? |
| ZEROP | Lisp function | (N) | ? |
Functions described as 'Lisp function' above are defined in the default
sysout file, `resources/lisp1.5.lsp`, which will be loaded by default unless
you specify another initfile on the command line.
Functions described as 'Host function' are implemented in Clojure, but if you're
brave you can redefine them in Lisp and the Lisp definitions will take precedence
over the Clojure implementations.
### Architectural plan
Not everything documented in this section is yet built. It indicates the

96
src/beowulf/bootstrap.clj
View file

@ -360,10 +360,9 @@
that an argument can be passed but I'm not sure of the semantics of
this."
[]
(when (lax? 'OBLIST)
(if (instance? ConsCell @oblist)
(make-beowulf-list (map CAR @oblist))
NIL)))
NIL))
(defn DEFINE
"Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten
@ -396,65 +395,78 @@
symbol val)
NIL))
(defn- traced-apply
"Like `APPLY`, but with trace output to console."
[function-symbol args lisp-fn environment depth]
(let [indent (apply str (repeat depth "-"))]
(println (str indent "> " function-symbol " " args))
(let [r (APPLY lisp-fn args environment depth)]
(println (str "<" indent " " r))
r)))
(defn- safe-apply
"We've a real problem with varargs functions when `args` is `NIL`, because
Clojure does not see `NIL` as an empty sequence."
[clj-fn args]
(let [args' (when (instance? ConsCell args) args)]
(apply clj-fn args')))
(defn- apply-symbolic
"Apply this `funtion-symbol` to these `args` in this `environment` and
return the result."
[^Symbol function-symbol ^ConsCell args ^ConsCell environment depth]
(let [fn (try (EVAL function-symbol environment depth)
[^Symbol function-symbol args ^ConsCell environment depth]
(let [lisp-fn (try (EVAL function-symbol environment depth)
(catch Throwable any (when (:trace *options*)
(println any))))
indent (apply str (repeat depth "-"))]
(if (and fn (not= fn NIL))
(if (traced? function-symbol)
(do
(println (str indent "> " function-symbol " " args))
(let [r (APPLY fn args environment depth)]
(println (str "<" indent " " r))
r))
(APPLY fn args environment depth))
(println any))))]
(if (and lisp-fn
(not= lisp-fn NIL)) (if (traced? function-symbol)
(traced-apply function-symbol
args
lisp-fn
environment
depth)
(APPLY lisp-fn args environment depth))
(case function-symbol ;; there must be a better way of doing this!
ADD1 (apply ADD1 args)
AND (apply AND args)
APPEND (apply APPEND args)
APPLY (apply APPLY args)
ADD1 (safe-apply ADD1 args)
AND (safe-apply AND args)
APPEND (safe-apply APPEND args)
APPLY (safe-apply APPLY args) ;; TODO: need to pass the environment and depth
ATOM (ATOM? (CAR args))
CAR (CAAR args)
CDR (CDAR args)
CONS (make-cons-cell (CAR args) (CADR args))
DEFINE (DEFINE (CAR args))
DIFFERENCE (DIFFERENCE (CAR args) (CADR args))
EQ (apply EQ args)
EQUAL (apply EQUAL args)
ERROR (apply ERROR args)
EQ (safe-apply EQ args)
EQUAL (safe-apply EQUAL args)
ERROR (safe-apply ERROR args)
;; think about EVAL. Getting the environment right is subtle
FIXP (apply FIXP args)
FIXP (safe-apply FIXP args)
GENSYM (GENSYM)
GREATERP (apply GREATERP args)
INTEROP (when (lax? INTEROP) (apply INTEROP args))
LESSP (apply LESSP args)
LIST (apply LIST args)
NUMBERP (apply NUMBERP args)
GREATERP (safe-apply GREATERP args)
INTEROP (when (lax? INTEROP) (safe-apply INTEROP args))
LESSP (safe-apply LESSP args)
LIST (safe-apply LIST args)
NUMBERP (safe-apply NUMBERP args)
OBLIST (OBLIST)
PLUS (apply PLUS args)
PLUS (safe-apply PLUS args)
PRETTY (when (lax? 'PRETTY)
(apply pretty-print args))
PRINT (apply print args)
QUOTIENT (apply QUOTIENT args)
(safe-apply pretty-print args))
PRINT (safe-apply print args)
QUOTIENT (safe-apply QUOTIENT args)
READ (READ)
REMAINDER (apply REMAINDER args)
RPLACA (apply RPLACA args)
RPLACD (apply RPLACD args)
SET (apply SET args)
REMAINDER (safe-apply REMAINDER args)
RPLACA (safe-apply RPLACA args)
RPLACD (safe-apply RPLACD args)
SET (safe-apply SET args)
SYSIN (when (lax? 'SYSIN)
(apply SYSIN args))
(safe-apply SYSIN args))
SYSOUT (when (lax? 'SYSOUT)
(if (empty? args)
(SYSOUT)
(apply SYSOUT args)))
(safe-apply SYSOUT args))
TERPRI (println)
TIMES (apply TIMES args)
TRACE (apply TRACE args)
UNTRACE (apply UNTRACE args)
TIMES (safe-apply TIMES args)
TRACE (safe-apply TRACE args)
UNTRACE (safe-apply UNTRACE args)
;; else
(ex-info "No function found"
{:context "APPLY"

11
src/beowulf/cons_cell.clj
View file

@ -138,7 +138,7 @@
(cond
(instance? ConsCell (. this CDR)) (str " " (subs (.toString (. this CDR)) 1))
(= NIL (. this CDR)) ")"
:else (str " . " (. this CDR))))))
:else (str " . " (. this CDR) ")")))))
(defn- to-string
"Printing ConsCells gave me a *lot* of trouble. This is an internal function
@ -161,12 +161,9 @@
s
(to-string car)
(cond
(or (nil? cdr) (= cdr NIL))
")"
cons?
" "
:else
(str " . " (to-string cdr) ")")))]
(or (nil? cdr) (= cdr NIL)) ")"
cons? " "
:else (str " . " (to-string cdr) ")")))]
(if
cons?
(recur cdr (inc n) ss)

6
src/beowulf/io.clj
View file

@ -71,7 +71,9 @@
**NOTE THAT** if the provided `filename` does not end with `.lsp` (which,
if you're writing it from the Lisp REPL, it won't), the extension `.lsp`
will be appended."
[filename]
([]
(SYSIN (or (:read *options*) "resources/lisp1.5.lsp")))
([filename]
(let [fp (file (full-path (str filename)))
file (when (and (.exists fp) (.canRead fp)) fp)
res (try (resource filename)
@ -82,4 +84,4 @@
{:context "SYSIN"
:filepath fp}
any))))]
(swap! oblist #(when (or % (seq content)) content))))
(swap! oblist #(when (or % (seq content)) content)))))

7
src/beowulf/oblist.clj
View file

@ -6,7 +6,12 @@
)
(def NIL
"The canonical empty list symbol."
"The canonical empty list symbol.
TODO: this doesn't really work, because (from Clojure) `(empty? NIL)` throws
an exception. It might be better to subclass beowulf.cons_cell.ConsCell to create
a new singleton class Nil which overrides the `empty` method of
IPersistentCollection?"
'NIL)
(def oblist

32
test/beowulf/lisp_test.clj Normal file
View file

@ -0,0 +1,32 @@
(ns beowulf.lisp-test
"The idea here is to test actual Lisp functions"
(:require [clojure.test :refer [deftest testing is use-fixtures]]
[beowulf.bootstrap :refer [EVAL]]
[beowulf.cons-cell :refer [make-beowulf-list]]
[beowulf.io :refer [SYSIN]]
[beowulf.read :refer [READ]]))
;; (use-fixtures :once (fn [f]
;; (try (SYSIN "resources/lisp1.5.lsp")
;; (f)
;; (catch Throwable any
;; (throw (ex-info "Failed to load Lisp sysout"
;; {:phase test
;; :function 'SYSIN
;; :file "resources/lisp1.5.lsp"}))))))
;; (deftest "COPY test"
;; ;; (testing "copy NIL"
;; ;; (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
;; ;; (let [expected "NIL"
;; ;; actual (with-out-str (println (EVAL (READ "(COPY NIL)"))))]
;; ;; (is (= actual expected))))
;; (testing "copy straight list"
;; (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
;; (let [expected (make-beowulf-list '(A B C))
;; actual (with-out-str (print (EVAL (READ "(COPY '(A B C))"))))]
;; (is (= actual expected))))
;; (testing "copy assoc list"
;; (let [expected "((A . 1) (B . 2) (C . 3))"
;; actual (with-out-str (println (EVAL (READ "(COPY '((A . 1) (B . 2) (C . 3)))"))))]
;; (is (= actual expected)))))

2
test/beowulf/mexpr_test.clj
View file

@ -53,7 +53,7 @@
;; I suspect as (CAR (LIST A B C)).
(let [expected "(CAR (LIST A B C))"
actual (print-str (gsp "car[(A B C)]"))]
actual (print-str (gsp "car[ list[a; b; c]]"))]
(is (= actual expected)))
))