Fixing parsing of numbers in mexpr mode.

This commit is contained in:
Simon Brooke 2023-03-29 08:50:34 +01:00
parent 6d887ff19b
commit 51a018b705
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
7 changed files with 47 additions and 13 deletions

View file

@ -130,7 +130,34 @@ You will require to have [Leiningen](https://leiningen.org/) installed.
This will start a Lisp 1.5 read/eval/print loop (REPL). This will start a Lisp 1.5 read/eval/print loop (REPL).
To end a session, type `quit` at the command prompt. Command line arguments are as follows:
```
-f FILEPATH, --file-path FILEPATH Set the path to the directory for reading and writing Lisp files.
-h, --help
-p PROMPT, --prompt PROMPT Sprecan:: Set the REPL prompt to PROMPT
-r INITFILE, --read INITFILE resources/lisp1.5.lsp Read Lisp system from file INITFILE
-s, --strict Strictly interpret the Lisp 1.5 language, without extensions.
-t, --trace Trace Lisp evaluation.
```
To end a session, type `STOP` at the command prompt.
### Input/output
Lisp 1.5 greatly predates modern computers. It had a facility to print to a line printer, or to punch cards on a punch-card machine, and it had a facility to read system images in from tape; but there's no file I/O as we would currently understand it, and, because there are no character strings and the valid characters within an atom are limited, it isn't easy to compose a sensible filename.
I've provided two functions to work around this problem.
#### SYSOUT
`SYSOUT` dumps the global object list to disk as a single S Expression (specifically: an association list). This allows you to persist your session, with all your current work, to disk. The function takes one argument, expected to be a symbol, and, if that argument is provided, writes a file whose name is that symbol with `.lsp` appended. If no argument is provided, it will construct a filename comprising the token `Sysout`, followed by the current date, followed by `.lsp`. In either case the file will be written to the directory given in the FILEPATH argument at startup time, or by default the current directory.
Obviously, `SYSOUT` may be called interactively (and this is the expected practice).
#### SYSIN
`SYSIN` reads a file from disk and overwrites the global object list with its contents. The expected practice is that this will be a file created by `SYSOUT`. A command line flag `--read` is provided so that you can specify
## Learning Lisp 1.5 ## Learning Lisp 1.5

View file

@ -5,7 +5,7 @@
;; it to NIL ;; it to NIL
(F . NIL) (F . NIL)
;; Binding all system functions to NIL so that you can see on the OBLIST that ;; Binding all system functions to NIL so that you can see on the OBLIST that
;; they exist ;; they exist.
(ADD1 . NIL) (ADD1 . NIL)
(APPEND . NIL) (APPEND . NIL)
(APPLY . NIL) (APPLY . NIL)
@ -25,6 +25,7 @@
(PLUS . NIL) (PLUS . NIL)
(PRETTY . NIL) (PRETTY . NIL)
(QUOTIENT . NIL) (QUOTIENT . NIL)
(READ . NIL)
(REMAINDER) (REMAINDER)
(RPLACA . NIL) (RPLACA . NIL)
(RPLACD . NIL) (RPLACD . NIL)

View file

@ -16,7 +16,8 @@
[beowulf.host :refer [ADD1 DIFFERENCE FIXP NUMBERP PLUS QUOTIENT [beowulf.host :refer [ADD1 DIFFERENCE FIXP NUMBERP PLUS QUOTIENT
REMAINDER RPLACA RPLACD SUB1 TIMES]] REMAINDER RPLACA RPLACD SUB1 TIMES]]
[beowulf.io :refer [SYSIN SYSOUT]] [beowulf.io :refer [SYSIN SYSOUT]]
[beowulf.oblist :refer [*options* oblist NIL]]) [beowulf.oblist :refer [*options* oblist NIL]]
[beowulf.read :refer [READ]])
(:import [beowulf.cons_cell ConsCell] (:import [beowulf.cons_cell ConsCell]
[clojure.lang Symbol])) [clojure.lang Symbol]))
@ -411,6 +412,7 @@
PLUS (apply PLUS args) PLUS (apply PLUS args)
PRETTY (apply pretty-print args) PRETTY (apply pretty-print args)
QUOTIENT (apply QUOTIENT args) QUOTIENT (apply QUOTIENT args)
READ (READ)
REMAINDER (apply REMAINDER args) REMAINDER (apply REMAINDER args)
RPLACA (apply RPLACA args) RPLACA (apply RPLACA args)
RPLACD (apply RPLACD args) RPLACD (apply RPLACD args)

View file

@ -174,7 +174,6 @@
(if (if
(coll? p) (coll? p)
(case (first p) (case (first p)
">" 'GREATERP
"LAMBDA" "LAMBDA"
:λexpr (make-cons-cell :λexpr (make-cons-cell
(generate (nth p 1)) (generate (nth p 1))
@ -184,6 +183,7 @@
:atom (symbol (second p)) :atom (symbol (second p))
:bindings (generate (second p)) :bindings (generate (second p))
:body (make-beowulf-list (map generate (rest p))) :body (make-beowulf-list (map generate (rest p)))
(:coefficient :exponent) (generate (second p))
:cond (gen-cond p) :cond (gen-cond p)
:cond-clause (gen-cond-clause p) :cond-clause (gen-cond-clause p)
(:decimal :integer) (read-string (strip-leading-zeros (second p))) (:decimal :integer) (read-string (strip-leading-zeros (second p)))
@ -191,7 +191,6 @@
:dotted-pair (make-cons-cell :dotted-pair (make-cons-cell
(generate (nth p 1)) (generate (nth p 1))
(generate (nth p 2))) (generate (nth p 2)))
:exponent (generate (second p))
:fncall (gen-fn-call p) :fncall (gen-fn-call p)
:iexpr (gen-iexpr p) :iexpr (gen-iexpr p)
:iop (case (second p) :iop (case (second p)
@ -212,7 +211,7 @@
(list 'QUOTE (symbol (upper-case (second p))))) (list 'QUOTE (symbol (upper-case (second p)))))
:mvar (symbol (upper-case (second p))) :mvar (symbol (upper-case (second p)))
:octal (let [n (read-string (strip-leading-zeros (second p) "0")) :octal (let [n (read-string (strip-leading-zeros (second p) "0"))
scale (generate (nth p 2))] scale (generate (nth p 3))]
(* n (expt 8 scale))) (* n (expt 8 scale)))
;; the quote read macro (which probably didn't exist in Lisp 1.5, but...) ;; the quote read macro (which probably didn't exist in Lisp 1.5, but...)
@ -221,7 +220,7 @@
(empty? (second p)) 0 (empty? (second p)) 0
(read-string (strip-leading-zeros (second p)))) (read-string (strip-leading-zeros (second p))))
:scientific (let [n (generate (second p)) :scientific (let [n (generate (second p))
exponent (generate (nth p 2))] exponent (generate (nth p 3))]
(* n (expt 10 exponent))) (* n (expt 10 exponent)))
;; default ;; default

View file

@ -78,7 +78,7 @@
integer := #'-?[1-9][0-9]*'; integer := #'-?[1-9][0-9]*';
decimal := #'-?[1-9][0-9]*\\.?[0-9]*' | #'0.[0-9]*'; decimal := #'-?[1-9][0-9]*\\.?[0-9]*' | #'0.[0-9]*';
scientific := coefficient e exponent; scientific := coefficient e exponent;
coefficient := decimal; coefficient := integer | decimal;
exponent := integer; exponent := integer;
e := 'E'; e := 'E';
octal := #'[+-]?[0-7]+{1,12}' q scale-factor; octal := #'[+-]?[0-7]+{1,12}' q scale-factor;

View file

@ -42,11 +42,16 @@
;; Wrapping in a function call puts us into mexpr contest; ;; Wrapping in a function call puts us into mexpr contest;
;; "T" would be interpreted as a sexpr, which would not be ;; "T" would be interpreted as a sexpr, which would not be
;; quoted. ;; quoted.
(let [expected "(ATOM A)" (let [expected "(ATOM (QUOTE A))"
actual (print-str (gsp "atom[A]"))] actual (print-str (gsp "atom[A]"))]
(is (= actual expected))) (is (= actual expected)))
(let [expected "(ATOM A)"
actual (print-str (gsp "atom[a]"))]
(is (= actual expected)))
;; I'm not clear how `car[(A B C)]` should be translated, but ;; I'm not clear how `car[(A B C)]` should be translated, but
;; I suspect as (CAR (LIST A B C)). ;; I suspect as (CAR (LIST A B C)).
(let [expected "(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[(A B C)]"))]
(is (= actual expected))) (is (= actual expected)))
@ -63,10 +68,10 @@
(deftest conditional-tests (deftest conditional-tests
(testing "Conditional expressions" (testing "Conditional expressions"
(let [expected "(COND ((ATOM X) X) (T (FF (CAR X))))" (let [expected "(COND ((ATOM X) X) ((QUOTE T) (FF (CAR X))))"
actual (print-str (gsp "[atom[x]->x; T->ff[car[x]]]"))] actual (print-str (gsp "[atom[x]->x; T->ff[car[x]]]"))]
(is (= actual expected))) (is (= actual expected)))
(let [expected "(LABEL FF (LAMBDA (X) (COND ((ATOM X) X) (T (FF (CAR X))))))" (let [expected "(LABEL FF (LAMBDA (X) (COND ((ATOM X) X) ((QUOTE T) (FF (CAR X))))))"
actual (print-str actual (print-str
(generate (generate
(simplify (simplify
@ -83,6 +88,6 @@
(deftest assignment-tests (deftest assignment-tests
(testing "Function assignment" (testing "Function assignment"
(let [expected "(SET (QUOTE FF) (QUOTE (LAMBDA (X) (COND ((ATOM X) X) (T (FF (CAR X)))))))" (let [expected "(SET (QUOTE FF) (QUOTE (LAMBDA (X) (COND ((ATOM X) X) ((QUOTE T) (FF (CAR X)))))))"
actual (print-str (gsp "ff[x]=[atom[x] -> x; T -> ff[car[x]]]"))] actual (print-str (gsp "ff[x]=[atom[x] -> x; T -> ff[car[x]]]"))]
(is (= actual expected))))) (is (= actual expected)))))