From 1f16241af79836635e674bca7465496e400cc84f Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 30 Mar 2023 14:29:20 +0100 Subject: [PATCH] Right, there's an awful lot of Lisp actually working... --- CHANGELOG.md | 12 ++- TEST.lsp | 35 ------- doc/mexpr.md | 4 +- project.clj | 1 + resources/bootstrap.lsp | 2 - resources/length.lsp | 1 - resources/lisp1.5.lsp | 114 +++++++++++++++------- resources/{ => mexpr}/apply-2.mexpr.lsp | 0 resources/{ => mexpr}/cond-test.mexpr.lsp | 0 resources/mexpr/copy.mexpr.lsp | 3 + resources/mexpr/divide.mexpr.lsp | 3 + resources/{ => mexpr}/ff.mexpr.lsp | 0 resources/{ => mexpr}/gcd.mexpr.lsp | 2 +- resources/mexpr/get.mexpr.lsp | 6 ++ resources/mexpr/intersection.mexpr.lsp | 5 + resources/mexpr/member.mexpr.lsp | 4 + resources/mexpr/null.mexpr.lsp | 7 ++ resources/mexpr/prop.mexpr.lsp | 4 + resources/mexpr/union.mexpr.lsp | 4 + resources/null.mexpr.lsp | 1 - resources/sexpr/conc.lsp | 1 + resources/sexpr/length.lsp | 1 + resources/sexpr/pair.lsp | 11 +++ resources/sexpr/repeat.lsp | 6 ++ src/beowulf/bootstrap.clj | 25 +++-- src/beowulf/host.clj | 26 ++++- src/beowulf/io.clj | 1 - src/beowulf/read.clj | 7 +- src/beowulf/reader/char_reader.clj | 50 ++++++++++ src/beowulf/reader/macros.clj | 3 + src/beowulf/reader/parser.clj | 8 +- 31 files changed, 250 insertions(+), 97 deletions(-) delete mode 100644 TEST.lsp delete mode 100644 resources/bootstrap.lsp delete mode 100644 resources/length.lsp rename resources/{ => mexpr}/apply-2.mexpr.lsp (100%) rename resources/{ => mexpr}/cond-test.mexpr.lsp (100%) create mode 100644 resources/mexpr/copy.mexpr.lsp create mode 100644 resources/mexpr/divide.mexpr.lsp rename resources/{ => mexpr}/ff.mexpr.lsp (100%) rename resources/{ => mexpr}/gcd.mexpr.lsp (53%) create mode 100644 resources/mexpr/get.mexpr.lsp create mode 100644 resources/mexpr/intersection.mexpr.lsp create mode 100644 resources/mexpr/member.mexpr.lsp create mode 100644 resources/mexpr/null.mexpr.lsp create mode 100644 resources/mexpr/prop.mexpr.lsp create mode 100644 resources/mexpr/union.mexpr.lsp delete mode 100644 resources/null.mexpr.lsp create mode 100644 resources/sexpr/conc.lsp create mode 100644 resources/sexpr/length.lsp create mode 100644 resources/sexpr/pair.lsp create mode 100644 resources/sexpr/repeat.lsp create mode 100644 src/beowulf/reader/char_reader.clj diff --git a/CHANGELOG.md b/CHANGELOG.md index c0095f4..9411b74 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,11 +7,19 @@ All notable changes to this project will be documented in this file. This change - 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. ### Added -- working EVAL, APPLY, READ and 24 other basic functions, of which at least four are not actually parts of the Lisp 1.5 specification. However, sufficient are present to allow the +- working `EVAL`, `APPLY`, `READ` and 24 other basic functions, of which at least four are not actually parts of the Lisp 1.5 specification. However, sufficient are present to allow the vast majority of Lisp 1.5 functions to be defined. ### Known to be missing -- property lists. + +- the array feature: `ARRAY`: planned, but not yet implemented. +- constants: `CSET`, `CSETQ`: planned, but not yet implemented. +- the compiler: `COMMON`, `COMPILE`, `LAP`, `OPDEFINE`, `READLAP`, `SPECIAL`, `UNCOMMON`, `UNSPECIAL`: not currently planned. +- property lists: `ATTRIB`, `GETPROP`, `PUTPROP`; these are planned, but not yet implemented. +- obsolete hardware related functions: `PUNCH`; not currently planned. +- memory debugging: `COUNT`; not currently planned. +- character I/O functions: `ADVANCE`, `CLEARBUFF`, `ENDREAD`, `INTERN`, `MKNAM`, `NUMOB`, `STARTREAD`, `UNPACK`; These are planned, but depend on working character I/O at Clojure level, which depends on JLine and looks like a lot of work. +- character classifying predicates: `LITER`, `DIGIT`, `OPCHAR`, `DASH`; these are planned but will probably wait for character I/O. Characters are not at this stage first class objects. [Unreleased]: https://github.com/your-name/beowulf/compare/0.1.1...HEAD [0.1.1]: https://github.com/your-name/beowulf/compare/0.1.0...0.1.1 diff --git a/TEST.lsp b/TEST.lsp deleted file mode 100644 index 8e474c2..0000000 --- a/TEST.lsp +++ /dev/null @@ -1,35 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Beowulf Sysout file generated at 2023-03-29T12:34:39.278 -;; generated by simon -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -((NULL - LAMBDA (X) (COND ((EQUAL X (QUOTE NIL)) (QUOTE T)) ((QUOTE T) (QUOTE F)))) - (GCD - LAMBDA - (X Y) - (COND - ((GREATERP X Y) (GCD Y X)) - ((EQUAL (REMAINDER Y X) 0) X) ((QUOTE T) (GCD (REMAINDER Y X) X)))) - (NIL) - (T . T) - (F) - (ADD1) - (APPEND) - (APPLY) - (ATOM) - (CAR) - (CDR) - (CONS) - (DEFINE) - (DIFFERENCE) - (EQ) - (EQUAL) - (EVAL) - (FIXP) - (INTEROP) - (NUMBERP) - (OBLIST) - (PLUS) - (PRETTY) - (QUOTIENT) (REMAINDER) (RPLACA) (RPLACD) (SET) (SYSIN) (SYSOUT) (TIMES)) diff --git a/doc/mexpr.md b/doc/mexpr.md index 13445de..60f9ff3 100644 --- a/doc/mexpr.md +++ b/doc/mexpr.md @@ -53,7 +53,9 @@ Is the value of `NIL` the atom `NIL`, or is it the empty list `()`? If the forme > This is a predicate useful for deciding when a list is exhausted. It is true if and only if its argument is `NIL`. -I think there is an ambiguity in referencing constants which are not bound to themselves in the M-Expression notation as given in the manual. This is particularly problematic with regards to `NIL`, but there may be others instances. +`NIL` is used explicitly in an M-Expression for example in the definition of `intersection` (Ibid, p15). + +I think there is an ambiguity in referencing constants which are not bound to themselves in the M-Expression notation as given in the manual. This is particularly problematic with regards to `NIL` and `F`, but there may be others instances. ### Curly braces diff --git a/project.clj b/project.clj index ceda0ea..ab4107f 100644 --- a/project.clj +++ b/project.clj @@ -14,6 +14,7 @@ [clojure.java-time "1.2.0"] [environ "1.2.0"] [instaparse "1.4.12"] + [org.jline/jline "3.23.0"] [rhizome "0.2.9"] ;; not needed in production builds ] :main ^:skip-aot beowulf.core diff --git a/resources/bootstrap.lsp b/resources/bootstrap.lsp deleted file mode 100644 index fdbfa2e..0000000 --- a/resources/bootstrap.lsp +++ /dev/null @@ -1,2 +0,0 @@ -(COMMENT '(THIS FILE WILL CONTAIN FUNCTION DEFINITIONS TO BOOTSTRAP LISP FULLSTOP - AT PRESENT WE HAVE NO COMMENT SYNTAX)) diff --git a/resources/length.lsp b/resources/length.lsp deleted file mode 100644 index b08df95..0000000 --- a/resources/length.lsp +++ /dev/null @@ -1 +0,0 @@ -(DEFUN LENGTH (L) (COND ((EQ NIL L) 0) (T (ADD1 (LENGTH (CDR L)))))) \ No newline at end of file diff --git a/resources/lisp1.5.lsp b/resources/lisp1.5.lsp index 0d2c983..94c3623 100644 --- a/resources/lisp1.5.lsp +++ b/resources/lisp1.5.lsp @@ -1,37 +1,77 @@ -;; Test comment -((NIL . NIL) -(T . T) -;; many functions return 'F on fail, but to make this mean fail I'm binding -;; it to NIL -(F . NIL) -;; Binding all system functions to NIL so that you can see on the OBLIST that -;; they exist. -(ADD1 . NIL) -(AND . NIL) -(APPEND . NIL) -(APPLY . NIL) -(ATOM . NIL) -(CAR . NIL) -(CDR . NIL) -(CONS . NIL) -(DEFINE . NIL) -(DIFFERENCE . NIL) -(EQ . NIL) -(EQUAL . NIL) -(EVAL) -(FIXP . NIL) -(INTEROP . NIL) -(NUMBERP . NIL) -(OBLIST . NIL) -(PLUS . NIL) -(PRETTY . NIL) -(QUOTIENT . NIL) -(READ . NIL) -(REMAINDER) -(RPLACA . NIL) -(RPLACD . NIL) -(SET . NIL) -(SYSIN . NIL) -(SYSOUT . NIL) -(TIMES . NIL) -) \ No newline at end of file +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Beowulf Sysout file generated at 2023-03-30T09:40:36.483 +;; generated by simon +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +((NIL) + (T . T) + (F) + (ADD1) + (AND) + (APPEND) + (APPLY) + (ATOM) + (CAR) + (CDR) + (CONS) + (COPY LAMBDA (X) + (COND ((NULL X) (QUOTE NIL)) + ((ATOM X) X) + ((QUOTE T) (CONS (COPY (CAR X)) (COPY (CDR X)))))) + (DEFINE) + (DIFFERENCE) + (DIVIDE LAMBDA (X Y) (CONS (QUOTIENT X Y) (CONS (REMAINDER X Y) (QUOTE NIL)))) + (ERROR) + (EQ) + (EQUAL) + (EVAL) + (FIXP) + (GENSYM) + (GET LAMBDA (X Y) + (COND ((NULL X) (QUOTE NIL)) + ((EQ (CAR X) Y) (CAR (CDR X))) + ((QUOTE T) (GET (CDR X) Y)))) + (GREATERP) + (INTEROP) + (INTERSECTION LAMBDA (X Y) + (COND ((NULL X) (QUOTE NIL)) + ((MEMBER (CAR X) Y) (CONS (CAR X) (INTERSECTION (CDR X) Y))) + ((QUOTE T) (INTERSECTION (CDR X) Y)))) + (LENGTH LAMBDA (L) (COND ((EQ NIL L) 0) (T (ADD1 (LENGTH (CDR L)))))) + (LESSP) + (MEMBER LAMBDA (A X) + (COND ((NULL X) (QUOTE F)) + ((EQ A (CAR X)) (QUOTE T)) + ((QUOTE T) (MEMBER A (CDR X))))) + (MINUSP LAMBDA (X) (LESSP X 0)) + (NULL LAMBDA (X) (COND ((EQUAL X NIL) (QUOTE T)) (T (QUOTE F)))) + (NUMBERP) + (OBLIST) + (ONEP LAMBDA (X) (EQ X 1)) + (PAIR LAMBDA (X Y) + (COND ((AND (NULL X) (NULL Y)) NIL) + ((NULL X) (ERROR 'F2)) + ((NULL Y) (ERROR 'F3)) + (T (CONS (CONS (CAR X) (CAR Y)) (PAIR (CDR X) (CDR Y)))))) + (PLUS) + (PRETTY) + (PRINT) + (PROP LAMBDA (X Y U) + (COND ((NULL X) (U)) + ((EQ (CAR X) Y) (CDR X)) + ((QUOTE T) (PROP (CDR X) Y U)))) + (QUOTIENT) + (READ) + (REMAINDER) + (REPEAT LAMBDA (N X) + (COND ((EQ N 0) NIL) + (T (CONS X (REPEAT (SUB1 N) X))))) + (RPLACA) + (RPLACD) + (SET) + (SUB1 LAMBDA (N) (DIFFERENCE N 1)) + (SYSIN) + (SYSOUT) + (TERPRI) + (TIMES) + (ZEROP LAMBDA (N) (EQ N 0))) diff --git a/resources/apply-2.mexpr.lsp b/resources/mexpr/apply-2.mexpr.lsp similarity index 100% rename from resources/apply-2.mexpr.lsp rename to resources/mexpr/apply-2.mexpr.lsp diff --git a/resources/cond-test.mexpr.lsp b/resources/mexpr/cond-test.mexpr.lsp similarity index 100% rename from resources/cond-test.mexpr.lsp rename to resources/mexpr/cond-test.mexpr.lsp diff --git a/resources/mexpr/copy.mexpr.lsp b/resources/mexpr/copy.mexpr.lsp new file mode 100644 index 0000000..abb8fa9 --- /dev/null +++ b/resources/mexpr/copy.mexpr.lsp @@ -0,0 +1,3 @@ +copy[x] = [null[x] -> NIL; + atom[x] -> x; + T -> cons[ copy[ car[x]]; copy[ cdr[x]]]] \ No newline at end of file diff --git a/resources/mexpr/divide.mexpr.lsp b/resources/mexpr/divide.mexpr.lsp new file mode 100644 index 0000000..1ae3ebb --- /dev/null +++ b/resources/mexpr/divide.mexpr.lsp @@ -0,0 +1,3 @@ +;; page 26 + +divide[x; y] = cons[ quotient[x; y]; cons[ remainder[x; y]; NIL]] \ No newline at end of file diff --git a/resources/ff.mexpr.lsp b/resources/mexpr/ff.mexpr.lsp similarity index 100% rename from resources/ff.mexpr.lsp rename to resources/mexpr/ff.mexpr.lsp diff --git a/resources/gcd.mexpr.lsp b/resources/mexpr/gcd.mexpr.lsp similarity index 53% rename from resources/gcd.mexpr.lsp rename to resources/mexpr/gcd.mexpr.lsp index 3190033..bf655e6 100644 --- a/resources/gcd.mexpr.lsp +++ b/resources/mexpr/gcd.mexpr.lsp @@ -2,4 +2,4 @@ gcd[x;y] = [x>y -> gcd[y;x]; rem[y;x] = 0 -> x; T -> gcd[rem[y;x];x]] -;; gcd[x;y] = [x>y -> gcd[y;x]; rem[y;x] = 0 -> x; T -> gcd[rem[y;x];x]] \ No newline at end of file +;; gcd[x;y] = [x>y -> gcd[y;x]; remainder[y;x] = 0 -> x; T -> gcd[remainder[y;x];x]] \ No newline at end of file diff --git a/resources/mexpr/get.mexpr.lsp b/resources/mexpr/get.mexpr.lsp new file mode 100644 index 0000000..3e475a1 --- /dev/null +++ b/resources/mexpr/get.mexpr.lsp @@ -0,0 +1,6 @@ +;; page 59; slightly modified because I don't at this stage want to +;; assume the existence of CADR + +get[x; y] = [null[x] -> NIL; + eq[car[x]; y] -> car[cdr[x]]; + T -> get[cdr[x]; y]] \ No newline at end of file diff --git a/resources/mexpr/intersection.mexpr.lsp b/resources/mexpr/intersection.mexpr.lsp new file mode 100644 index 0000000..1c6f320 --- /dev/null +++ b/resources/mexpr/intersection.mexpr.lsp @@ -0,0 +1,5 @@ +;; page 15 + +intersection[x;y] = [null[x] -> NIL; + member[car[x]; y] -> cons[car[x]; intersection[cdr[x]; y]]; + T -> intersection[cdr[x]; y]] \ No newline at end of file diff --git a/resources/mexpr/member.mexpr.lsp b/resources/mexpr/member.mexpr.lsp new file mode 100644 index 0000000..1e4985e --- /dev/null +++ b/resources/mexpr/member.mexpr.lsp @@ -0,0 +1,4 @@ +;; page 15 +member[a; x] = [null[x] -> F; + eq[a; car[x]] -> T; + T-> member[a; cdr[x]]] \ No newline at end of file diff --git a/resources/mexpr/null.mexpr.lsp b/resources/mexpr/null.mexpr.lsp new file mode 100644 index 0000000..36e424f --- /dev/null +++ b/resources/mexpr/null.mexpr.lsp @@ -0,0 +1,7 @@ +null[x] = [x = NIL -> T; T -> F] + +(SETQ NULL + '(LAMBDA (X) + (COND + ((EQUAL X NIL) 'T) + (T (QUOTE F))))) \ No newline at end of file diff --git a/resources/mexpr/prop.mexpr.lsp b/resources/mexpr/prop.mexpr.lsp new file mode 100644 index 0000000..033b3b6 --- /dev/null +++ b/resources/mexpr/prop.mexpr.lsp @@ -0,0 +1,4 @@ +;; page 59 +prop[x;y;u] = [null[x] -> u[]; + eq[car[x]; y] -> cdr[x]; + T -> prop[cdr[x]; y; u]] \ No newline at end of file diff --git a/resources/mexpr/union.mexpr.lsp b/resources/mexpr/union.mexpr.lsp new file mode 100644 index 0000000..672e227 --- /dev/null +++ b/resources/mexpr/union.mexpr.lsp @@ -0,0 +1,4 @@ +;; page 15 +union[x; y] = [null[x] -> y; + member[car[x]; y] -> union[cdr[x]; y]; + T -> cons[car[x]; union[cdr[x]; y]]] \ No newline at end of file diff --git a/resources/null.mexpr.lsp b/resources/null.mexpr.lsp deleted file mode 100644 index b984d21..0000000 --- a/resources/null.mexpr.lsp +++ /dev/null @@ -1 +0,0 @@ -null[x] = [x = NIL -> T; T -> F] \ No newline at end of file diff --git a/resources/sexpr/conc.lsp b/resources/sexpr/conc.lsp new file mode 100644 index 0000000..2738a45 --- /dev/null +++ b/resources/sexpr/conc.lsp @@ -0,0 +1 @@ +;; TODO \ No newline at end of file diff --git a/resources/sexpr/length.lsp b/resources/sexpr/length.lsp new file mode 100644 index 0000000..5cd02df --- /dev/null +++ b/resources/sexpr/length.lsp @@ -0,0 +1 @@ +(SETQ LENGTH '(LAMBDA (L) (COND ((EQ NIL L) 0) (T (ADD1 (LENGTH (CDR L))))))) \ No newline at end of file diff --git a/resources/sexpr/pair.lsp b/resources/sexpr/pair.lsp new file mode 100644 index 0000000..2b52b6d --- /dev/null +++ b/resources/sexpr/pair.lsp @@ -0,0 +1,11 @@ +;; PAIR is defined on page 60 of the manual, but the definition depends on both +;; PROG and GO, and I haven't got those working yet; so this is a pure +;; functional implementation. +;; Return a list of pairs from lists `x` and `y`, required both to have the same +;; length. + +(DEFUN PAIR (X Y) + (COND ((AND (NULL X) (NULL Y)) NIL) + ((NULL X) (ERROR 'F2)) + ((NULL Y) (ERROR 'F3)) + (T (CONS (CONS (CAR X) (CAR Y)) (PAIR (CDR X) (CDR Y)))))) \ No newline at end of file diff --git a/resources/sexpr/repeat.lsp b/resources/sexpr/repeat.lsp new file mode 100644 index 0000000..edc4487 --- /dev/null +++ b/resources/sexpr/repeat.lsp @@ -0,0 +1,6 @@ +;; REPEAT is not present in the Lisp 1.5 manual, but it's so simple and so +;; useful that it seems a legitimate extension. + +(DEFUN REPEAT (N X) + (COND ((EQ N 0) NIL) + (T (CONS X (REPEAT (SUB1 N) X))))) \ No newline at end of file diff --git a/src/beowulf/bootstrap.clj b/src/beowulf/bootstrap.clj index 330034b..770763b 100644 --- a/src/beowulf/bootstrap.clj +++ b/src/beowulf/bootstrap.clj @@ -13,7 +13,8 @@ [clojure.tools.trace :refer [deftrace]] [beowulf.cons-cell :refer [CAR CDR CONS LIST make-beowulf-list make-cons-cell pretty-print T F]] - [beowulf.host :refer [AND ADD1 DIFFERENCE FIXP NUMBERP PLUS QUOTIENT + [beowulf.host :refer [AND ADD1 DIFFERENCE ERROR FIXP GENSYM GREATERP LESSP + NUMBERP PLUS QUOTIENT REMAINDER RPLACA RPLACD SUB1 TIMES]] [beowulf.io :refer [SYSIN SYSOUT]] [beowulf.oblist :refer [*options* oblist NIL]] @@ -353,9 +354,11 @@ :detail :strict})))) (defn OBLIST - "Not certain whether or not this is part of LISP 1.5; adapted from PSL. - return the current value of the object list. Note that in PSL this function - returns a list of the symbols bound, not the whole association list." + "Return a list of the symbols currently bound on the object list. + + **NOTE THAT** in the Lisp 1.5 manual, footnote at the bottom of page 69, it implies + that an argument can be passed but I'm not sure of the semantics of + this." [] (when (lax? 'OBLIST) (if (instance? ConsCell @oblist) @@ -415,23 +418,33 @@ DIFFERENCE (DIFFERENCE (CAR args) (CADR args)) EQ (apply EQ args) EQUAL (apply EQUAL args) + ERROR (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) (apply SYSOUT 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) ;; else (ex-info "No function found" diff --git a/src/beowulf/host.clj b/src/beowulf/host.clj index f703100..b367ea2 100644 --- a/src/beowulf/host.clj +++ b/src/beowulf/host.clj @@ -2,7 +2,8 @@ "provides Lisp 1.5 functions which can't be (or can't efficiently be) implemented in Lisp 1.5, which therefore need to be implemented in the host language, in this case Clojure." - (:require [beowulf.cons-cell :refer [F make-beowulf-list T]] + (:require [clojure.string :refer [upper-case]] + [beowulf.cons-cell :refer [F make-beowulf-list T]] ;; note hyphen - this is Clojure... [beowulf.oblist :refer [NIL]]) (:import [beowulf.cons_cell ConsCell] @@ -14,13 +15,13 @@ ;; portability. (defn AND - "True if and only if none of my `args` evaluate to either `F` or `NIL`, + "`T` if and only if none of my `args` evaluate to either `F` or `NIL`, else `F`. In `beowulf.host` principally because I don't yet feel confident to define varargs functions in Lisp." [& args] - (if (empty? (filter #(or (= 'F %) (empty? %)) args)) + (if (empty? (filter #(or (= 'F %) (= NIL %) (nil? %)) args)) 'T 'F)) @@ -116,3 +117,22 @@ (defn NUMBERP [x] (if (number? x) T F)) + +(defn GENSYM + "Generate a unique symbol." + [] + (symbol (upper-case (str (gensym "SYM"))))) + +(defn ERROR + "Throw an error" + [& args] + (throw (ex-info "LISP ERROR" {:cause (apply vector args) + :phase :eval}))) + +(defn LESSP + [x y] + (< x y)) + +(defn GREATERP + [x y] + (> x y)) \ No newline at end of file diff --git a/src/beowulf/io.clj b/src/beowulf/io.clj index 653cd58..14d798a 100644 --- a/src/beowulf/io.clj +++ b/src/beowulf/io.clj @@ -83,4 +83,3 @@ :filepath fp} any))))] (swap! oblist #(when (or % (seq content)) content)))) - diff --git a/src/beowulf/read.clj b/src/beowulf/read.clj index 31b0a65..032c23b 100644 --- a/src/beowulf/read.clj +++ b/src/beowulf/read.clj @@ -13,7 +13,8 @@ Both these extensions can be disabled by using the `--strict` command line switch." - (:require [beowulf.reader.generate :refer [generate]] + (:require [beowulf.reader.char-reader :refer [read-chars]] + [beowulf.reader.generate :refer [generate]] [beowulf.reader.parser :refer [parse]] [beowulf.reader.simplify :refer [remove-optional-space simplify]] [clojure.string :refer [join split starts-with? trim]]) @@ -78,10 +79,10 @@ the final Lisp reader. `input` should be either a string representation of a LISP expression, or else an input stream. A single form will be read." ([] - (gsp (read-from-console))) + (gsp (read-chars))) ([input] (cond - (empty? input) (gsp (read-from-console)) + (empty? input) (READ) (string? input) (gsp input) (instance? InputStream input) (READ (slurp input)) :else (throw (ex-info "READ: `input` should be a string or an input stream" {}))))) diff --git a/src/beowulf/reader/char_reader.clj b/src/beowulf/reader/char_reader.clj new file mode 100644 index 0000000..0d6ac3e --- /dev/null +++ b/src/beowulf/reader/char_reader.clj @@ -0,0 +1,50 @@ +(ns beowulf.reader.char-reader + "Provide sensible line editing, auto completion, and history recall. + + None of what's needed here is really working yet, and a pull request with + a working implementation would be greatly welcomed. + + ## What's needed (rough specification) + + 1. Carriage return **does not** cause input to be returned, **unless** + a. the number of open brackets `(` and closing brackets `)` match; and + b. the number of open square brackets `[` and closing square brackets `]` also match; + 2. aborts editing and returns the string `STOP`; + 3. and scroll back and forward through history, but ideally I'd like + this to be the Lisp history (i.e. the history of S-Expressions actually read by `READ`, + rather than the strings which were supplied to `READ`); + 4. offers potential auto-completions taken from the value of `(OBLIST)`, ideally the + current value, not the value at the time the session started; + 5. and offer movement and editing within the line." + (:import [org.jline.reader LineReader LineReaderBuilder] + [org.jline.terminal TerminalBuilder])) + +;; It looks from the example given [here](https://github.com/jline/jline3/blob/master/demo/src/main/java/org/jline/demo/Repl.java) +;; as though JLine could be used to build a perfect line-reader for Beowulf; but it also +;; looks as though you'd need a DPhil in JLine to write it, and I don't have +;; the time. + +(def get-reader + "Return a reader, first constructing it if necessary. + + **NOTE THAT** this is not settled API. The existence and call signature of + this function is not guaranteed in future versions." + (memoize (fn [] + (let [term (.build (.system (TerminalBuilder/builder) true))] + (.build (.terminal (LineReaderBuilder/builder) term)))))) + +(defn read-chars + "A drop-in replacement for `clojure.core/read-line`, except that line editing + and history should be enabled. + + **NOTE THAT** this does not work yet, but it is in the API because I hope + that it will work later!" + [] + (let [eddie (get-reader)] + (loop [s (.readLine eddie)] + (if (and (= (count (re-seq #"\(" s)) + (count (re-seq #"\)" s))) + (= (count (re-seq #"\[]" s)) + (count (re-seq #"\]" s)))) + s + (recur (str s " " (.readLine eddie))))))) \ No newline at end of file diff --git a/src/beowulf/reader/macros.clj b/src/beowulf/reader/macros.clj index 51b6ecd..f8c652c 100644 --- a/src/beowulf/reader/macros.clj +++ b/src/beowulf/reader/macros.clj @@ -10,6 +10,9 @@ ;; LABEL does it, which I'm not yet sure of) we're not yet able to implement ;; things which don't evaluate arguments. +;; TODO: at this stage, the following should probably also be read macros: +;; DEFINE + (def ^:dynamic *readmacros* {:car {'DEFUN (fn [f] (LIST 'SET (LIST 'QUOTE (second f)) diff --git a/src/beowulf/reader/parser.clj b/src/beowulf/reader/parser.clj index ae87075..51783c1 100644 --- a/src/beowulf/reader/parser.clj +++ b/src/beowulf/reader/parser.clj @@ -27,9 +27,9 @@ "mexpr := λexpr | fncall | defn | cond | mvar | mconst | iexpr | number | mexpr comment; λexpr := λ lsqb bindings semi-colon body rsqb; λ := 'λ'; - bindings := lsqb args rsqb; + bindings := lsqb args rsqb | lsqb rsqb; body := (mexpr semi-colon opt-space)* mexpr; - fncall := fn-name lsqb args rsqb; + fncall := fn-name bindings; lsqb := '['; rsqb := ']'; lbrace := '{'; @@ -38,7 +38,7 @@ cond := lsqb (opt-space cond-clause semi-colon opt-space)* cond-clause rsqb; cond-clause := mexpr opt-space arrow opt-space mexpr opt-space; arrow := '->'; - args := (opt-space mexpr semi-colon opt-space)* mexpr; + args := mexpr | (opt-space mexpr semi-colon opt-space)* opt-space mexpr opt-space; fn-name := mvar; mvar := #'[a-z]+'; mconst := #'[A-Z]+'; @@ -75,7 +75,7 @@ ;; Lisp 1.5 supported octal as well as decimal and scientific notation "number := integer | decimal | scientific | octal; - integer := #'-?[1-9][0-9]*'; + integer := #'-?[0-9]+'; decimal := integer dot integer; scientific := coefficient e exponent; coefficient := decimal | integer;