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

Huge amount of work, not much real progress.

Browse source
This commit is contained in:
Simon Brooke 2023-03-24 22:18:18 +00:00
parent 75da14790c
commit c0a362f213
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
12 changed files with 266 additions and 182 deletions

3
.gitignore vendored
View file

@ -12,3 +12,6 @@ pom.xml.asc
.hg/
.idea/
*~
.calva/
.clj-kondo/
.lsp/

25
beowulf.iml Normal file
View file

@ -0,0 +1,25 @@
<?xml version="1.0" encoding="UTF-8"?>
<module cursive.leiningen.project.LeiningenProjectsManager.displayName="beowulf:0.2.1-SNAPSHOT" cursive.leiningen.project.LeiningenProjectsManager.isLeinModule="true" type="JAVA_MODULE" version="4">
<component name="NewModuleRootManager" LANGUAGE_LEVEL="JDK_1_5">
<output url="file://$MODULE_DIR$/target/default/classes" />
<output-test url="file://$MODULE_DIR$/target/default/classes" />
<content url="file://$MODULE_DIR$">
<sourceFolder url="file://$MODULE_DIR$/src" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/dev-resources" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/resources" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/test" isTestSource="true" />
<excludeFolder url="file://$MODULE_DIR$/target" />
<excludeFolder url="file://$MODULE_DIR$/target/default" />
</content>
<orderEntry type="inheritedJdk" />
<orderEntry type="sourceFolder" forTests="false" />
<orderEntry type="library" name="Leiningen: clojure-complete:0.2.5" level="project" />
<orderEntry type="library" name="Leiningen: environ:1.1.0" level="project" />
<orderEntry type="library" name="Leiningen: instaparse:1.4.10" level="project" />
<orderEntry type="library" name="Leiningen: nrepl:0.6.0" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/clojure:1.8.0" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/math.numeric-tower:0.0.4" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/tools.cli:0.4.2" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/tools.trace:0.7.10" level="project" />
</component>
</module>

22
resources/apply-2.mexpr.lsp Normal file
View file

@ -0,0 +1,22 @@
;; see page 70 of Lisp 1.5 Programmers Manual; this expands somewhat
;; on the accounts of eval and apply given on page 13. This is M-expr
;; syntax, obviously.
;; apply
;; NOTE THAT I suspect there is a typo in the printed manual in line
;; 7 of this definition, namely a missing closing square bracket before
;; the final semi-colon; that has been corrected here.
apply[fn;args;a] = [
null[fn] -> NIL;
atom[fn] -> [get[fn;EXPR] -> apply[expr; args; a];
get[fn;SUBR] -> {spread[args];
$ALIST := a;
TSX subr4, 4};
T -> apply[cdr[sassoc[fn; a; λ[[]; error[A2]]]]; args a]];
eq[car[fn]; LABEL] -> apply[caddr[fn]; args;
cons[cons[cadr[fn];caddr[fn]]; a]];
eq[car[fn]; FUNARG] -> apply[cadr[fn]; args; caddr[fn]];
eq[car[fn]; LAMBDA] -> eval[caddr[fn]; nconc[pair[cadr[fn]; args]; a]];
T -> apply[eval[fn;a]; args; a]]

3
resources/cond-test.mexpr.lsp Normal file
View file

@ -0,0 +1,3 @@
;; from page 5
[eq[car[x];A]->cons[B;cdr[x]];T->x]

0
resources/lisp1.5.lsp
View file

58
src/beowulf/bootstrap.clj
View file

@ -88,36 +88,36 @@
\a (uaf (.first l) (butlast path))
\d (uaf (.getCdr l) (butlast path)))))
(defn CAAR [x] (uaf x (seq "aa")))
(defn CADR [x] (uaf x (seq "ad")))
(defn CDDR [x] (uaf x (seq "dd")))
(defn CDAR [x] (uaf x (seq "da")))
(defmacro CAAR [x] `(uaf ~x '(\a \a)))
(defmacro CADR [x] `(uaf ~x '(\a \d)))
(defmacro CDDR [x] `(uaf ~x '(\d \d)))
(defmacro CDAR [x] `(uaf ~x '(\d \a)))
(defn CAAAR [x] (uaf x (seq "aaa")))
(defn CAADR [x] (uaf x (seq "aad")))
(defn CADAR [x] (uaf x (seq "ada")))
(defn CADDR [x] (uaf x (seq "add")))
(defn CDDAR [x] (uaf x (seq "dda")))
(defn CDDDR [x] (uaf x (seq "ddd")))
(defn CDAAR [x] (uaf x (seq "daa")))
(defn CDADR [x] (uaf x (seq "dad")))
(defmacro CAAAR [x] `(uaf ~x '(\a \a \a)))
(defmacro CAADR [x] `(uaf ~x '(\a \a \d)))
(defmacro CADAR [x] `(uaf ~x '(\a \d \a)))
(defmacro CADDR [x] `(uaf ~x '(\a \d \d)))
(defmacro CDDAR [x] `(uaf ~x '(\d \d \a)))
(defmacro CDDDR [x] `(uaf ~x '(\d \d \d)))
(defmacro CDAAR [x] `(uaf ~x '(\d \a \a)))
(defmacro CDADR [x] `(uaf ~x '(\d \a \d)))
(defn CAAAAR [x] (uaf x (seq "aaaa")))
(defn CAADAR [x] (uaf x (seq "aada")))
(defn CADAAR [x] (uaf x (seq "adaa")))
(defn CADDAR [x] (uaf x (seq "adda")))
(defn CDDAAR [x] (uaf x (seq "ddaa")))
(defn CDDDAR [x] (uaf x (seq "ddda")))
(defn CDAAAR [x] (uaf x (seq "daaa")))
(defn CDADAR [x] (uaf x (seq "dada")))
(defn CAAADR [x] (uaf x (seq "aaad")))
(defn CAADDR [x] (uaf x (seq "aadd")))
(defn CADADR [x] (uaf x (seq "adad")))
(defn CADDDR [x] (uaf x (seq "addd")))
(defn CDDADR [x] (uaf x (seq "ddad")))
(defn CDDDDR [x] (uaf x (seq "dddd")))
(defn CDAADR [x] (uaf x (seq "daad")))
(defn CDADDR [x] (uaf x (seq "dadd")))
(defmacro CAAAAR [x] `(uaf ~x '(\a \a \a \a)))
(defmacro CAADAR [x] `(uaf ~x '(\a \a \d \a)))
(defmacro CADAAR [x] `(uaf ~x '(\a \d \a \a)))
(defmacro CADDAR [x] `(uaf ~x '(\a \d \d \a)))
(defmacro CDDAAR [x] `(uaf ~x '(\d \d \a \a)))
(defmacro CDDDAR [x] `(uaf ~x '(\d \d \d \a)))
(defmacro CDAAAR [x] `(uaf ~x '(\d \a \a \a)))
(defmacro CDADAR [x] `(uaf ~x '(\d \a \d \a)))
(defmacro CAAADR [x] `(uaf ~x '(\a \a \a \d)))
(defmacro CAADDR [x] `(uaf ~x '(\a \a \d \d)))
(defmacro CADADR [x] `(uaf ~x '(\a \d \a \d)))
(defmacro CADDDR [x] `(uaf ~x '(\a \d \d \d)))
(defmacro CDDADR [x] `(uaf ~x '(\d \d \a \d)))
(defmacro CDDDDR [x] `(uaf ~x '(\d \d \d \d)))
(defmacro CDAADR [x] `(uaf ~x '(\d \a \a \d)))
(defmacro CDADDR [x] `(uaf ~x '(\d \a \d \d)))
(defn EQ
"Returns `T` if and only if both `x` and `y` are bound to the same atom,
@ -318,8 +318,6 @@
(=
(ATOM? function)
T)(cond
;; TODO: doesn't check whether `function` is bound in the environment;
;; we'll need that before we can bootstrap.
(= function 'CAR) (CAAR args)
(= function 'CDR) (CDAR args)
(= function 'CONS) (make-cons-cell (CAR args) (CADR args))

17
src/beowulf/cons_cell.clj
View file

@ -195,16 +195,21 @@
[this writer]
(.write writer (to-string this)))
(defmacro make-cons-cell
(defn make-cons-cell
"Construct a new instance of cons cell with this `car` and `cdr`."
[car cdr]
`(ConsCell. ~car ~cdr))
(try
(ConsCell. car cdr)
(catch Exception any
(throw (ex-info "Cound not construct cons cell" {:car car
:cdr cdr} any)))))
(defn make-beowulf-list
"Construct a linked list of cons cells with the same content as the
sequence `x`."
[x]
(cond
(try
(cond
(empty? x) NIL
(coll? x) (ConsCell.
(if
@ -213,4 +218,8 @@
(first x))
(make-beowulf-list (rest x)))
:else
NIL))
NIL)
(catch Exception any
(throw (ex-info "Could not construct Beowulf list"
{:content x}
any)))))

6
src/beowulf/core.clj
View file

@ -55,13 +55,13 @@
(println
(str
"\nHider wilcuman. Béowulf is mín nama.\n"
(if
(when
(System/getProperty "beowulf.version")
(str "Síðe " (System/getProperty "beowulf.version") "\n"))
(if
(when
(:help (:options args))
(:summary args))
(if (:errors args)
(when (:errors args)
(apply str (interpose "; " (:errors args))))
"\nSprecan 'quit' tó laéfan\n"))
(binding [*options* (:options args)]

236
src/beowulf/read.clj
View file

@ -15,7 +15,8 @@
switch."
(:require [beowulf.bootstrap :refer [*options*]]
[clojure.math.numeric-tower :refer [expt]]
[clojure.string :refer [starts-with? upper-case]]
[clojure.pprint :refer [pprint]]
[clojure.string :refer [join split starts-with? upper-case]]
[instaparse.core :as i]
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]]))
@ -33,13 +34,23 @@
"Parse a string presented as argument into a parse tree which can then
be operated upon further."
(i/parser
(str
(str
;; top level: we accept mexprs as well as sexprs.
"expr := mexpr | sexpr;"
"expr := mexpr | sexpr | opt-space expr opt-space;"
;; comments. I'm pretty confident Lisp 1.5 did NOT have these.
"comment := opt-space <';;'> opt-space #'[^\\n\\r]*';"
;; there's a notation comprising a left brace followed by mexprs
;; followed by a right brace which doesn't seem to be documented
;; but I think must represent a prog(?)
;; "prog := lbrace exprs rbrace;"
;; mexprs. I'm pretty clear that Lisp 1.5 could never read these,
;; but it's a convenience.
"mexpr := λexpr | fncall | defn | cond | mvar | mexpr comment;
"exprs := expr | exprs;"
"mexpr := λexpr | fncall | defn | cond | mvar | mexpr comment;
λexpr := λ lsqb bindings semi-colon body rsqb;
λ := 'λ';
bindings := lsqb args rsqb;
@ -47,6 +58,8 @@
fncall := fn-name lsqb args rsqb;
lsqb := '[';
rsqb := ']';
lbrace := '{';
rbrace := '}';
defn := mexpr opt-space '=' opt-space mexpr;
cond := lsqb (cond-clause semi-colon opt-space)* cond-clause rsqb;
cond-clause := expr opt-space arrow opt-space expr;
@ -56,13 +69,10 @@
mvar := #'[a-z]+';
semi-colon := ';';"
;; comments. I'm pretty confident Lisp 1.5 did NOT have these.
"comment := opt-space <';;'> #'[^\\n\\r]*';"
;; sexprs. Note it's not clear to me whether Lisp 1.5 had the quote macro,
;; but I've included it on the basis that it can do little harm.
"sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment;
list := lpar sexpr rpar | lpar (sexpr sep)* rpar | lpar (sexpr sep)* dot-terminal;
"sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment;
list := lpar sexpr rpar | lpar (sexpr sep)* rpar | lpar (sexpr sep)* dot-terminal | lbrace exprs rbrace;
dotted-pair := lpar dot-terminal ;
dot := '.';
lpar := '(';
@ -76,7 +86,7 @@
atom := #'[A-Z][A-Z0-9]*';"
;; Lisp 1.5 supported octal as well as decimal and scientific notation
"number := integer | decimal | scientific | octal;
"number := integer | decimal | scientific | octal;
integer := #'-?[1-9][0-9]*';
decimal := #'-?[1-9][0-9]*\\.?[0-9]*' | #'0.[0-9]*';
scientific := coefficient e exponent;
@ -92,55 +102,57 @@
an `ex-info`, with `p` as the value of its `:failure` key."
([p]
(if
(instance? instaparse.gll.Failure p)
(instance? instaparse.gll.Failure p)
(throw (ex-info "Ic ne behæfd" {:cause :parse-failure :failure p}))
(simplify p :sexpr)))
([p context]
(if
(if
(coll? p)
(apply
(apply
vector
(remove
#(if (coll? %) (empty? %))
(case (first p)
(:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context)
(:λexpr
:args :bindings :body :cond :cond-clause :dot-terminal
:fncall :octal :quoted-expr :scientific) (map #(simplify % context) p)
(:arrow :dot :e :lpar :lsqb :opt-space :q :quote :rpar :rsqb
:semi-colon :sep :space) nil
:atom (if
(= context :mexpr)
[:quoted-expr p]
p)
:comment (if
(:strict *options*)
(throw
(ex-info "Cannot parse comments in strict mode"
{:cause :strict})))
:dotted-pair (if
(= context :mexpr)
[:fncall
[:mvar "cons"]
[:args
(simplify (nth p 1) context)
(simplify (nth p 2) context)]]
(map simplify p))
:mexpr (if
#(when (coll? %) (empty? %))
(case (first p)
(:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context)
(:λexpr
:args :bindings :body :cond :cond-clause :dot-terminal
:fncall :octal :quoted-expr :scientific) (map #(simplify % context) p)
(:arrow :dot :e :lpar :lsqb :opt-space :q :quote :rpar :rsqb
:semi-colon :sep :space) nil
:atom (if
(= context :mexpr)
[:quoted-expr p]
p)
:comment (when
(:strict *options*)
(throw
(ex-info "Cannot parse meta expressions in strict mode"
{:cause :strict}))
(simplify (second p) :mexpr))
:list (if
(= context :mexpr)
[:fncall
[:mvar "list"]
[:args (apply vector (map simplify (rest p)))]]
(map #(simplify % context) p))
(throw
(ex-info "Cannot parse comments in strict mode"
{:cause :strict})))
:dotted-pair (if
(= context :mexpr)
[:fncall
[:mvar "cons"]
[:args
(simplify (nth p 1) context)
(simplify (nth p 2) context)]]
(map simplify p))
:mexpr (if
(:strict *options*)
(throw
(ex-info "Cannot parse meta expressions in strict mode"
{:cause :strict}))
(simplify (second p) :mexpr))
:list (if
(= context :mexpr)
[:fncall
[:mvar "list"]
[:args (apply vector (map simplify (rest p)))]]
(map #(simplify % context) p))
;;default
p)))
p)))
(if (coll? (first p))
(map #(simplify % context) p)
p))))
p)))
;; # From Lisp 1.5 Programmers Manual, page 10
@ -197,34 +209,36 @@
"Generate a cond clause from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a cond clause."
[p]
(if
(and (coll? p)(= :cond-clause (first p)))
(when
(and (coll? p) (= :cond-clause (first p)))
(make-beowulf-list
(list (generate (nth p 1))
(generate (nth p 2))))))
(list (if (= (nth p 1) [:quoted-expr [:atom "T"]])
'T
(generate (nth p 1)))
(generate (nth p 2))))))
(defn gen-cond
"Generate a cond statement from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a (MEXPR) cond statement."
[p]
(if
(and (coll? p)(= :cond (first p)))
(when
(and (coll? p) (= :cond (first p)))
(make-beowulf-list
(cons
'COND
(map
gen-cond-clause
(rest p))))))
(cons
'COND
(map
generate
(rest p))))))
(defn gen-fn-call
"Generate a function call from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a (MEXPR) function call."
[p]
(if
(and (coll? p)(= :fncall (first p))(= :mvar (first (second p))))
(when
(and (coll? p) (= :fncall (first p)) (= :mvar (first (second p))))
(make-cons-cell
(generate (second p))
(generate (nth p 2)))))
(generate (second p))
(generate (nth p 2)))))
(defn gen-dot-terminated-list
@ -238,12 +252,12 @@
(and (coll? (first p)) (= :dot-terminal (first (first p))))
(let [dt (first p)]
(make-cons-cell
(generate (nth dt 1))
(generate (nth dt 2))))
(generate (nth dt 1))
(generate (nth dt 2))))
:else
(make-cons-cell
(generate (first p))
(gen-dot-terminated-list (rest p)))))
(generate (first p))
(gen-dot-terminated-list (rest p)))))
(defn strip-leading-zeros
@ -254,52 +268,60 @@
(strip-leading-zeros s ""))
([s prefix]
(if
(empty? s) "0"
(case (first s)
(\+ \-)(strip-leading-zeros (subs s 1) (str (first s) prefix))
"0" (strip-leading-zeros (subs s 1) prefix)
(str prefix s)))))
(empty? s) "0"
(case (first s)
(\+ \-) (strip-leading-zeros (subs s 1) (str (first s) prefix))
"0" (strip-leading-zeros (subs s 1) prefix)
(str prefix s)))))
(defn generate
"Generate lisp structure from this parse tree `p`. It is assumed that
`p` has been simplified."
[p]
(if
(coll? p)
(case (first p)
:λ "LAMBDA"
:λexpr (make-cons-cell
(generate (nth p 1))
(make-cons-cell (generate (nth p 2))
(generate (nth p 3))))
(:args :list) (gen-dot-terminated-list (rest p))
:atom (symbol (second p))
:bindings (generate (second p))
:body (make-beowulf-list (map generate (rest p)))
:cond (gen-cond p)
(:decimal :integer) (read-string (strip-leading-zeros (second p)))
:dotted-pair (make-cons-cell
(generate (nth p 1))
(generate (nth p 2)))
:exponent (generate (second p))
:fncall (gen-fn-call p)
:mvar (symbol (upper-case (second p)))
:octal (let [n (read-string (strip-leading-zeros (second p) "0"))
scale (generate (nth p 2))]
(* n (expt 8 scale)))
(try
(if
(coll? p)
(case (first p)
:λ "LAMBDA"
:λexpr (make-cons-cell
(generate (nth p 1))
(make-cons-cell (generate (nth p 2))
(generate (nth p 3))))
:args (make-beowulf-list (map generate (rest p)))
:atom (symbol (second p))
:bindings (generate (second p))
:body (make-beowulf-list (map generate (rest p)))
:cond (gen-cond p)
:cond-clause (gen-cond-clause p)
(:decimal :integer) (read-string (strip-leading-zeros (second p)))
:dotted-pair (make-cons-cell
(generate (nth p 1))
(generate (nth p 2)))
:exponent (generate (second p))
:fncall (gen-fn-call p)
:list (gen-dot-terminated-list (rest p))
:mvar (symbol (upper-case (second p)))
:octal (let [n (read-string (strip-leading-zeros (second p) "0"))
scale (generate (nth p 2))]
(* n (expt 8 scale)))
;; the quote read macro (which probably didn't exist in Lisp 1.5, but...)
:quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p))))
:scale-factor (if
(empty? (second p)) 0
(read-string (strip-leading-zeros (second p))))
:scientific (let [n (generate (second p))
exponent (generate (nth p 2))]
(* n (expt 10 exponent)))
:quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p))))
:scale-factor (if
(empty? (second p)) 0
(read-string (strip-leading-zeros (second p))))
:scientific (let [n (generate (second p))
exponent (generate (nth p 2))]
(* n (expt 10 exponent)))
;; default
(throw (Exception. (str "Cannot yet generate " (first p)))))
p))
(throw (ex-info (str "Unrecognised head: " (first p))
{:generating p})))
p)
(catch Throwable any
(throw (ex-info "Could not generate"
{:generating p}
any)))))
(defmacro gsp
"Shortcut macro - the internals of read; or, if you like, read-string.

8
test/beowulf/bootstrap_test.clj
View file

@ -179,22 +179,22 @@
actual (MEMBER
(gsp "ALBERT")
(gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))
(is (= actual expected)))
(let [expected 'T
actual (MEMBER
(gsp "BELINDA")
(gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))
(is (= actual expected)))
(let [expected 'T
actual (MEMBER
(gsp "ELFREDA")
(gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))
(is (= actual expected)))
(let [expected 'F
actual (MEMBER
(gsp "BERTRAM")
(gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
(= actual expected))))
(is (= actual expected)))))
(deftest pairlis-tests
(testing "pairlis"

22
test/beowulf/mexpr_test.clj
View file

@ -25,10 +25,10 @@
(deftest variable-tests
(testing "Variable translation"
(let [expected "X"
actual (print-str (generate (simplify (parse "x"))))]
actual (print-str (gsp "x"))]
(is (= actual expected)))
(let [expected "CAR"
actual (print-str (generate (simplify (parse "car"))))]
actual (print-str (gsp "car"))]
(is (= actual expected)))
))
@ -39,28 +39,30 @@
;; Wrapping in a function call puts us into mexpr contest;
;; "T" would be interpreted as a sexpr, which would not be
;; quoted.
(let [expected "(ATOM (QUOTE T))"
actual (print-str (generate (simplify (parse "atom[T]"))))]
(is (= actual expected)))
(let [expected "(ATOM (QUOTE A))"
actual (print-str (gsp "atom[A]"))]
(is (= actual expected)
"Atoms should normally be quoted"))
;; I'm not clear how `car[(A B C)]` should be translated, but
;; I suspect as (CAR (LIST 'A 'B 'C)).
))
(deftest fncall-tests
(testing "Function calls"
(let [expected "(CAR X)"
actual (print-str (generate (simplify (parse "car[x]"))))]
actual (print-str (gsp "car[x]"))]
(is (= actual expected)))
(let [expected "(FF (CAR X))"
actual (print-str (generate (simplify (parse "ff[car[x]]"))))]
actual (print-str (gsp "ff[car[x]]"))]
(is (= actual expected)))))
(deftest conditional-tests
(testing "Conditional expressions"
(let [expected "(COND ((ATOM X) X) ((QUOTE T) (FF (CAR X))))"
actual (print-str (generate (simplify (parse "[atom[x]->x; T->ff[car[x]]]"))))]
(let [expected "(COND ((ATOM X) X) (T (FF (CAR X))))"
actual (print-str (gsp "[atom[x]->x; T->ff[car[x]]]"))]
(is (= actual expected)))
(let [expected "(LABEL FF (LAMBDA (X) (COND ((ATOM X) X) ((QUOTE T) (FF (CAR X))))))"
(let [expected "(LABEL FF (LAMBDA (X) (COND ((ATOM X) X) (T (FF (CAR X))))))"
actual (print-str
(generate
(simplify

48
test/beowulf/sexpr_test.clj
View file

@ -10,19 +10,19 @@
(deftest atom-tests
(testing "Reading atoms"
(let [expected 'A
actual (generate (simplify (parse (str expected))))]
actual (gsp(str expected))]
(is (= actual expected)))
(let [expected 'APPLE
actual (generate (simplify (parse (str expected))))]
actual (gsp(str expected))]
(is (= actual expected)))
(let [expected 'PART2
actual (generate (simplify (parse (str expected))))]
actual (gsp(str expected))]
(is (= actual expected)))
(let [expected 'EXTRALONGSTRINGOFLETTERS
actual (generate (simplify (parse (str expected))))]
actual (gsp(str expected))]
(is (= actual expected)))
(let [expected 'A4B66XYZ2
actual (generate (simplify (parse (str expected))))]
actual (gsp(str expected))]
(is (= actual expected)))))
(deftest comment-tests
@ -54,67 +54,67 @@
(deftest number-tests
(testing "Reading octal numbers"
(let [expected 1
actual (generate (simplify (parse "1Q")))]
actual (gsp "1Q")]
(is (= actual expected)))
(let [expected -1
actual (generate (simplify (parse "-1Q")))]
actual (gsp "-1Q")]
(is (= actual expected)))
(let [expected 8
actual (generate (simplify (parse "1Q1")))]
actual (gsp "1Q1")]
(is (= actual expected)))
(let [expected -8
actual (generate (simplify (parse "-1Q1")))]
actual (gsp "-1Q1")]
(is (= actual expected)))
(let [expected 128
actual (generate (simplify (parse "2Q2")))]
actual (gsp "2Q2")]
(is (= actual expected)))
(let [expected 2093056
actual (generate (simplify (parse "777Q4")))]
actual (gsp "777Q4")]
(is (= actual expected))))
(testing "Reading decimal numbers - broadly should be homiconic"
(let [expected 7
actual (generate (simplify (parse "7")))]
actual (gsp "7")]
(is (= actual expected)))
(let [expected -7
actual (generate (simplify (parse "-7")))]
actual (gsp "-7")]
(is (= actual expected)))
(let [expected 3.141592
actual (generate (simplify (parse "3.141592")))]
actual (gsp "3.141592")]
(is (= actual expected)))
(let [expected 1234567890
actual (generate (simplify (parse "1234567890")))]
actual (gsp "1234567890")]
(is (= actual expected)))
(let [expected -45.23
actual (generate (simplify (parse "-45.23")))]
actual (gsp "-45.23")]
(is (= actual expected))))
(testing "Reading scientific notation")
(let [expected 2/5
actual (generate (simplify (parse "4E-1")))]
actual (gsp "4E-1")]
(is (< (abs (- actual expected)) 0.0001)))
(let [expected 60
actual (generate (simplify (parse "6E1")))]
actual (gsp "6E1")]
(is (< (abs (- actual expected)) 0.0001)))
(let [expected 60
actual (generate (simplify (parse "600.00E-1")))]
actual (gsp "600.00E-1")]
(is (< (abs (- actual expected)) 0.0001)))
(let [expected 60
actual (generate (simplify (parse "0.6E2")))]
actual (gsp "0.6E2")]
(is (< (abs (- actual expected)) 0.0001))))
(deftest dotted-pair-tests
(testing "Reading dotted pairs"
(let [expected "(A . B)"
actual (print-str (generate (simplify (parse expected))))]
actual (print-str (gsp expected))]
(is (= actual expected)))
(let [expected "(A B C . D)"
actual (print-str (generate (simplify (parse expected))))]
actual (print-str (gsp expected))]
(is (= actual expected)))
(let [expected "(A B (C . D) E)"
actual (print-str (generate (simplify (parse expected))))]
actual (print-str (gsp expected))]
(is (= actual expected)))))
(deftest list-tests
(testing "Reading arbitrarily structured lists"
(let [expected "(DEFUN FACT (X) (COND ((ZEROP X) 1) (T (TIMES X (FACT (SUB1 X))))))"
actual (print-str (generate (simplify (parse expected))))]
actual (print-str (gsp expected))]
(is (= actual expected)))))