diff --git a/.gitignore b/.gitignore index 833bc4e..1719386 100644 --- a/.gitignore +++ b/.gitignore @@ -16,3 +16,4 @@ pom.xml.asc .clj-kondo/ .lsp/ resources/scratch.lsp +Sysout*.lsp \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index 9411b74..c487ddf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md index 27de79f..30a6ec9 100644 --- a/README.md +++ b/README.md @@ -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 diff --git a/src/beowulf/bootstrap.clj b/src/beowulf/bootstrap.clj index f419944..8b80285 100644 --- a/src/beowulf/bootstrap.clj +++ b/src/beowulf/bootstrap.clj @@ -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))) + (if (instance? ConsCell @oblist) + (make-beowulf-list (map CAR @oblist)) + NIL)) (defn DEFINE "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten @@ -396,70 +395,83 @@ 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) - (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)) - (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) - 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) + [^Symbol function-symbol args ^ConsCell environment depth] + (let [lisp-fn (try (EVAL function-symbol environment depth) + (catch Throwable any (when (:trace *options*) + (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 (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 (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) - 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) - OBLIST (OBLIST) - PLUS (apply PLUS args) - PRETTY (when (lax? 'PRETTY) - (apply pretty-print args)) - PRINT (apply print args) - QUOTIENT (apply QUOTIENT args) - READ (READ) - REMAINDER (apply REMAINDER args) - RPLACA (apply RPLACA args) - RPLACD (apply RPLACD args) - SET (apply SET args) - SYSIN (when (lax? 'SYSIN) - (apply SYSIN args)) - SYSOUT (when (lax? 'SYSOUT) - (if (empty? args) - (SYSOUT) - (apply SYSOUT args))) - TERPRI (println) - TIMES (apply TIMES args) - TRACE (apply TRACE args) - UNTRACE (apply UNTRACE args) + FIXP (safe-apply FIXP args) + GENSYM (GENSYM) + 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 (safe-apply PLUS args) + PRETTY (when (lax? 'PRETTY) + (safe-apply pretty-print args)) + PRINT (safe-apply print args) + QUOTIENT (safe-apply QUOTIENT args) + READ (READ) + REMAINDER (safe-apply REMAINDER args) + RPLACA (safe-apply RPLACA args) + RPLACD (safe-apply RPLACD args) + SET (safe-apply SET args) + SYSIN (when (lax? 'SYSIN) + (safe-apply SYSIN args)) + SYSOUT (when (lax? 'SYSOUT) + (safe-apply SYSOUT args)) + TERPRI (println) + TIMES (safe-apply TIMES args) + TRACE (safe-apply TRACE args) + UNTRACE (safe-apply UNTRACE args) ;; else - (ex-info "No function found" - {:context "APPLY" - :function function-symbol - :args args}))))) + (ex-info "No function found" + {:context "APPLY" + :function function-symbol + :args args}))))) (defn APPLY "Apply this `function` to these `arguments` in this `environment` and return diff --git a/src/beowulf/cons_cell.clj b/src/beowulf/cons_cell.clj index a4585d9..78c4726 100644 --- a/src/beowulf/cons_cell.clj +++ b/src/beowulf/cons_cell.clj @@ -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) diff --git a/src/beowulf/io.clj b/src/beowulf/io.clj index 14d798a..2eac979 100644 --- a/src/beowulf/io.clj +++ b/src/beowulf/io.clj @@ -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))))) diff --git a/src/beowulf/oblist.clj b/src/beowulf/oblist.clj index 5c36256..2b7d36c 100644 --- a/src/beowulf/oblist.clj +++ b/src/beowulf/oblist.clj @@ -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 diff --git a/test/beowulf/lisp_test.clj b/test/beowulf/lisp_test.clj new file mode 100644 index 0000000..c01a309 --- /dev/null +++ b/test/beowulf/lisp_test.clj @@ -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))))) diff --git a/test/beowulf/mexpr_test.clj b/test/beowulf/mexpr_test.clj index 888e6e7..1c38145 100644 --- a/test/beowulf/mexpr_test.clj +++ b/test/beowulf/mexpr_test.clj @@ -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))) ))