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

Much improvement; printing works, and bootstrap tests started

Browse source 
There's probably redundant code in this, but I want to commit here just in case what I think is redundant isn't!
This commit is contained in:
Simon Brooke 2019-08-16 16:56:13 +01:00
parent 12bbd0076a
commit dfe4333dfa
8 changed files with 195 additions and 105 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
src/beowulf/cons_cell.clj
View file

@ -14,13 +14,19 @@
;; next and more must return ISeq:
;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java
(more [this] (if
(seq? this)
(if
(= (.CDR this) NIL)
clojure.lang.PersistentList/EMPTY
(.CDR this)))
(.CDR this))
NIL))
(next [this] (if
(seq? this)
(if
(= (.CDR this) NIL)
nil ;; next returns nil when empty
(.CDR this)))
(.CDR this))
NIL))
clojure.lang.Seqable
(seq [this] this)
@ -31,12 +37,50 @@
clojure.lang.IPersistentCollection
(count [this] (if
(seq? this)
(if
(= (.CDR this) NIL)
0
(inc (count (.CDR this)))))
(inc (count (.CDR this))))
0))
(empty [this] false)
(equiv [this other] false))
(defn- to-string
"Printing ConsCells gave me a *lot* of trouble. This is an internal function
used by the print-method override (below) in order that the standard Clojure
`print` and `str` functions will print ConsCells correctly. The argument
`cell` must, obviously, be an instance of `ConsCell`."
[cell]
(loop [c cell
n 0
s "("]
(if
(instance? beowulf.cons_cell.ConsCell c)
(let [car (.CAR c)
cdr (.CDR c)
cons? (instance? beowulf.cons_cell.ConsCell cdr)
ss (str
s
(to-string car)
(cond
cons?
" "
(or (nil? cdr) (= cdr 'NIL))
")"
:else
(str " . " (to-string cdr) ")")))]
(if
cons?
(recur cdr (inc n) ss)
ss))
(str c))))
(defmethod clojure.core/print-method beowulf.cons_cell.ConsCell
[this writer]
(.write writer (to-string this)))
(defn make-cons-cell
[a d]
(ConsCell. a d))

7
src/beowulf/core.clj
View file

@ -1,7 +1,6 @@
(ns beowulf.core
(:require [beowulf.eval :refer [primitive-eval oblist]]
[beowulf.read :refer [primitive-read]]
[beowulf.print :refer [primitive-print prin]])
[beowulf.read :refer [primitive-read]])
(:gen-class))
(defn -main
@ -12,6 +11,6 @@
(print ":: ")
(flush)
(let [input (primitive-read)]
(println (str "\tI read: " (prin input)))
(println (str "> "(prin (primitive-eval input @oblist))))
(println (str "\tI read: " input))
(println (str "> " (primitive-eval input @oblist)))
(recur))))

20
src/beowulf/eval.clj
View file

@ -31,14 +31,18 @@
(if
(instance? beowulf.cons_cell.ConsCell x)
(.CAR x)
NIL))
(throw
(Exception.
(str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")))))
(defn cdr
[x]
(if
(instance? beowulf.cons_cell.ConsCell x)
(.CDR x)
NIL))
(throw
(Exception.
(str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")")))))
(defn uaf
"Universal access function; `l` is expected to be an arbitrary list, `path`
@ -47,14 +51,10 @@
[l path]
(cond
(null l) NIL
(not (instance? beowulf.cons_cell.ConsCell l))
(throw (Exception. (str "Unexpected list argument to uaf: `" l "`")))
(empty? (rest path))(case (first path)
\a (car l)
\d (cdr l))
:else (case (first path)
\a (uaf (car l) (rest path))
\d (uaf (cdr l) (rest path)))))
(empty? path) l
:else (case (last path)
\a (uaf (car l) (butlast path))
\d (uaf (cdr l) (butlast path)))))
(defn caar [x] (uaf x (seq "aa")))
(defn cadr [x] (uaf x (seq "ad")))

59
src/beowulf/print.clj
View file

@ -1,59 +0,0 @@
(ns beowulf.print
)
(defprotocol Printable
(prin [x]))
(extend-type
clojure.lang.Symbol
Printable
(prin [x] (str x)))
(extend-protocol
Printable
nil
(prin [x] "NIL"))
(extend-protocol
Printable
clojure.lang.Symbol
(prin [x] (str x))
java.lang.Number
(prin [x] (str x))
beowulf.cons_cell.ConsCell
(prin [x]
(loop [c x
n 0
s "("]
(let [car (.CAR c)
cdr (.CDR c)
cons? (instance? beowulf.cons_cell.ConsCell cdr)
ss (str
s
(prin car)
(cond
cons?
" "
(or (nil? cdr) (= cdr 'NIL))
")"
:else
(str " . " (prin cdr) ")")))]
(if
cons?
(recur cdr (inc n) ss)
ss))))
java.lang.Object
(prin
[x]
(str x)))
(defn primitive-print
[x]
(if
(satisfies? beowulf.print.Printable x) (prin x)
(str x)))

116
test/beowulf/bootstrap_test.clj Normal file
View file

@ -0,0 +1,116 @@
(ns beowulf.bootstrap-test
(:require [clojure.math.numeric-tower :refer [abs]]
[clojure.test :refer :all]
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]
[beowulf.eval :refer :all]
[beowulf.read :refer [parse simplify generate]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This file is primarily tests of the functions in `beowulf.eval` - which
;;; are Clojure functions, but aim to provide sufficient functionality that
;;; Beowulf can get up to the level of running its own code.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftest atom-tests
(testing "primitive-atom"
(let [expected T
actual (primitive-atom T)]
(is (= actual expected) "T is an atom (symbol)"))
(let [expected T
actual (primitive-atom (generate (simplify (parse "HELLO"))))]
(is (= actual expected) "HELLO is an atom (symbol)"))
(let [expected T
actual (primitive-atom 7)]
(is (= actual expected)
"I'm not actually certain whether a number should be treated as an
atom, but I'm guessing so"))
(let [expected F
actual (primitive-atom (make-cons-cell 'A 'B))]
(is (= actual expected) "A dotted pair is explicitly not an atom."))
(let [expected F
actual (primitive-atom (generate (simplify (parse "(A B C D)"))))]
(is (= actual expected) "A list is explicitly not an atom")))
(testing "primitive-atom?"
(let [expected T
actual (primitive-atom? T)]
(is (= actual expected) "T is an atom (symbol)"))
(let [expected T
actual (primitive-atom? (generate (simplify (parse "HELLO"))))]
(is (= actual expected) "HELLO is an atom (symbol)"))
(let [expected T
actual (primitive-atom? 7)]
(is (= actual expected)
"I'm not actually certain whether a number should be treated as an
atom, but I'm guessing so"))
(let [expected NIL
actual (primitive-atom? (make-cons-cell 'A 'B))]
(is (= actual expected) "A dotted pair is explicitly not an atom."))
(let [expected NIL
actual (primitive-atom? (generate (simplify (parse "(A B C D)"))))]
(is (= actual expected) "A list is explicitly not an atom"))
))
(deftest access-function-tests
(testing "car"
(let [expected 'A
actual (car (make-cons-cell 'A 'B))]
(is (= actual expected) "A is car of (A . B)"))
(let [expected 'A
actual (car (generate (simplify (parse "(A B C D)"))))]
(is (= actual expected) "A is car of (A B C D)"))
(is (thrown-with-msg?
Exception
#"Cannot take CAR of `.*"
(car 'T))
"Can't take the car of an atom")
(is (thrown-with-msg?
Exception
#"Cannot take CAR of `.*"
(car 7))
"Can't take the car of a number"))
(testing "cdr"
(let [expected 'B
actual (cdr (make-cons-cell 'A 'B))]
(is (= actual expected) "B is cdr of (A . B)"))
(let [expected 'B
actual (cdr (generate (simplify (parse "(A B C D)"))))]
(is (instance? beowulf.cons_cell.ConsCell actual)
"cdr of (A B C D) is a cons cell")
(is (= (car actual) expected) "the car of that cons-cell is B"))
(is (thrown-with-msg?
Exception
#"Cannot take CDR of `.*"
(cdr 'T))
"Can't take the cdr of an atom")
(is (thrown-with-msg?
Exception
#"Cannot take CDR of `.*"
(cdr 7))
"Can't take the cdr of a number"))
(let [s (generate
(simplify
(parse
"((((1 . 2) 3)(4 5) 6)(7 (8 9) (10 11 12) 13) 14 (15 16) 17)")))]
;; structure for testing access functions
(testing "cadr"
(let [expected 'B
actual (cadr (generate (simplify (parse "(A B C D)"))))]
(is (= actual expected))))
(testing "caddr"
(let [expected 'C
actual (caddr (generate (simplify (parse "(A B C D)"))))]
(is (= actual expected))))
(testing "cadddr"
(let [expected 'D
actual (cadddr (generate (simplify (parse "(A B C D)"))))]
(is (= actual expected))))
(testing "caaaar"
(let [expected "1"
actual (print-str (caaaar s))]
(is (= actual expected))))
))

17
test/beowulf/mexpr_test.clj
View file

@ -1,7 +1,6 @@
(ns beowulf.mexpr-test
(:require [clojure.test :refer :all]
[beowulf.read :refer [parse simplify generate]]
[beowulf.print :refer :all]))
[beowulf.read :refer [parse simplify generate]]))
;; These tests are taken generally from the examples on page 10 of
;; Lisp 1.5 Programmers Manual:
@ -23,10 +22,10 @@
(deftest variable-tests
(testing "Variable translation"
(let [expected "X"
actual (prin (generate (simplify (parse "x"))))]
actual (print-str (generate (simplify (parse "x"))))]
(is (= actual expected)))
(let [expected "CAR"
actual (prin (generate (simplify (parse "car"))))]
actual (print-str (generate (simplify (parse "car"))))]
(is (= actual expected)))
))
@ -38,7 +37,7 @@
;; "T" would be interpreted as a sexpr, which would not be
;; quoted.
(let [expected "(ATOM (QUOTE T))"
actual (prin (generate (simplify (parse "atom[T]"))))]
actual (print-str (generate (simplify (parse "atom[T]"))))]
(is (= actual expected)))
;; I'm not clear how `car[(A B C)]` should be translated, but
;; I suspect as (CAR (LIST 'A 'B 'C)).
@ -47,19 +46,19 @@
(deftest fncall-tests
(testing "Function calls"
(let [expected "(CAR X)"
actual (prin (generate (simplify (parse "car[x]"))))]
actual (print-str (generate (simplify (parse "car[x]"))))]
(is (= actual expected)))
(let [expected "(FF (CAR X))"
actual (prin (generate (simplify (parse "ff[car[x]]"))))]
actual (print-str (generate (simplify (parse "ff[car[x]]"))))]
(is (= actual expected)))))
(deftest conditional-tests
(testing "Conditional expressions"
(let [expected "(COND ((ATOM X) X) ((QUOTE T) (FF (CAR X))))"
actual (prin (generate (simplify (parse "[atom[x]->x; T->ff[car[x]]]"))))]
actual (print-str (generate (simplify (parse "[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))))))"
actual (prin
actual (print-str
(generate
(simplify
(parse "label[ff;λ[[x];[atom[x]->x; T->ff[car[x]]]]]"))))]

8
test/beowulf/read_test.clj
View file

@ -1,8 +0,0 @@
(ns beowulf.read-test
(:require [clojure.test :refer :all]
[beowulf.core :refer :all]))
;; (deftest a-test
;; (testing "FIXME, I fail."
;; (is (= 0 1))))

11
test/beowulf/sexpr_test.clj
View file

@ -2,8 +2,7 @@
(:require [clojure.math.numeric-tower :refer [abs]]
[clojure.test :refer :all]
[beowulf.cons-cell :refer :all]
[beowulf.read :refer [parse simplify generate]]
[beowulf.print :refer :all]))
[beowulf.read :refer [parse simplify generate]]))
;; broadly, sexprs should be homoiconic
@ -78,17 +77,17 @@
(deftest dotted-pair-tests
(testing "Reading dotted pairs"
(let [expected "(A . B)"
actual (prin (generate (simplify (parse expected))))]
actual (print-str (generate (simplify (parse expected))))]
(is (= actual expected)))
(let [expected "(A B C . D)"
actual (prin (generate (simplify (parse expected))))]
actual (print-str (generate (simplify (parse expected))))]
(is (= actual expected)))
(let [expected "(A B (C . D) E)"
actual (prin (generate (simplify (parse expected))))]
actual (print-str (generate (simplify (parse 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 (prin (generate (simplify (parse expected))))]
actual (print-str (generate (simplify (parse expected))))]
(is (= actual expected)))))