From c0a362f213c910f99161a9d5191647684b687214 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 24 Mar 2023 22:18:18 +0000 Subject: [PATCH] Huge amount of work, not much real progress. --- .gitignore | 3 + beowulf.iml | 25 ++++ resources/apply-2.mexpr.lsp | 22 +++ resources/cond-test.mexpr.lsp | 3 + resources/lisp1.5.lsp | 0 src/beowulf/bootstrap.clj | 58 ++++---- src/beowulf/cons_cell.clj | 17 ++- src/beowulf/core.clj | 6 +- src/beowulf/read.clj | 236 +++++++++++++++++--------------- test/beowulf/bootstrap_test.clj | 8 +- test/beowulf/mexpr_test.clj | 22 +-- test/beowulf/sexpr_test.clj | 48 +++---- 12 files changed, 266 insertions(+), 182 deletions(-) create mode 100644 beowulf.iml create mode 100644 resources/apply-2.mexpr.lsp create mode 100644 resources/cond-test.mexpr.lsp delete mode 100644 resources/lisp1.5.lsp diff --git a/.gitignore b/.gitignore index 5903fe9..9c425ee 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,6 @@ pom.xml.asc .hg/ .idea/ *~ +.calva/ +.clj-kondo/ +.lsp/ \ No newline at end of file diff --git a/beowulf.iml b/beowulf.iml new file mode 100644 index 0000000..7bbff5e --- /dev/null +++ b/beowulf.iml @@ -0,0 +1,25 @@ + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/resources/apply-2.mexpr.lsp b/resources/apply-2.mexpr.lsp new file mode 100644 index 0000000..d447d1a --- /dev/null +++ b/resources/apply-2.mexpr.lsp @@ -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]] + diff --git a/resources/cond-test.mexpr.lsp b/resources/cond-test.mexpr.lsp new file mode 100644 index 0000000..a817644 --- /dev/null +++ b/resources/cond-test.mexpr.lsp @@ -0,0 +1,3 @@ +;; from page 5 + +[eq[car[x];A]->cons[B;cdr[x]];T->x] diff --git a/resources/lisp1.5.lsp b/resources/lisp1.5.lsp deleted file mode 100644 index e69de29..0000000 diff --git a/src/beowulf/bootstrap.clj b/src/beowulf/bootstrap.clj index d49d92e..87c9ac9 100644 --- a/src/beowulf/bootstrap.clj +++ b/src/beowulf/bootstrap.clj @@ -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)) diff --git a/src/beowulf/cons_cell.clj b/src/beowulf/cons_cell.clj index 90e462d..a14a362 100644 --- a/src/beowulf/cons_cell.clj +++ b/src/beowulf/cons_cell.clj @@ -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))))) diff --git a/src/beowulf/core.clj b/src/beowulf/core.clj index 6ea2757..0a3b2bf 100644 --- a/src/beowulf/core.clj +++ b/src/beowulf/core.clj @@ -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)] diff --git a/src/beowulf/read.clj b/src/beowulf/read.clj index 6ede7e8..54ce008 100644 --- a/src/beowulf/read.clj +++ b/src/beowulf/read.clj @@ -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. diff --git a/test/beowulf/bootstrap_test.clj b/test/beowulf/bootstrap_test.clj index 25ac23d..6ec59ca 100644 --- a/test/beowulf/bootstrap_test.clj +++ b/test/beowulf/bootstrap_test.clj @@ -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" diff --git a/test/beowulf/mexpr_test.clj b/test/beowulf/mexpr_test.clj index 92dc201..9be0e21 100644 --- a/test/beowulf/mexpr_test.clj +++ b/test/beowulf/mexpr_test.clj @@ -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 diff --git a/test/beowulf/sexpr_test.clj b/test/beowulf/sexpr_test.clj index fe665a1..7086976 100644 --- a/test/beowulf/sexpr_test.clj +++ b/test/beowulf/sexpr_test.clj @@ -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)))))