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

Safety commit before major change - this does not work.

Browse source
This commit is contained in:
Simon Brooke 2019-08-22 14:44:16 +01:00
parent fd7cc71480
commit 34096ecae5
12 changed files with 392 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -10,3 +10,5 @@ pom.xml.asc
/.nrepl-port /.nrepl-port
.hgignore .hgignore
.hg/ .hg/
.idea/
*~

2
README.md
View file

@ -1,6 +1,6 @@
# beowulf # beowulf
LISP 1.5 is to all Lisp dialects as Beowulf is to Emglish literature. LISP 1.5 is to all Lisp dialects as Beowulf is to English literature.
## What this is ## What this is

26
beowulf.iml Normal file
View file

@ -0,0 +1,26 @@
<?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">
<output url="file://$MODULE_DIR$/target/default/classes" />
<output-test url="file://$MODULE_DIR$/target/default/classes" />
<exclude-output />
<content url="file://$MODULE_DIR$">
<sourceFolder url="file://$MODULE_DIR$/dev-resources" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/resources" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/src/clojure" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/src/java" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/test" isTestSource="true" />
<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>

6
project.clj
View file

@ -13,7 +13,9 @@
[org.clojure/tools.trace "0.7.10"] [org.clojure/tools.trace "0.7.10"]
[environ "1.1.0"] [environ "1.1.0"]
[instaparse "1.4.10"]] [instaparse "1.4.10"]]
:java-source-paths ["src/java"]
:main ^:skip-aot beowulf.core :main ^:skip-aot beowulf.core
:min-lein-version "2.0.0"
:plugins [[lein-cloverage "1.1.1"] :plugins [[lein-cloverage "1.1.1"]
[lein-codox "0.10.7"] [lein-codox "0.10.7"]
[lein-environ "1.1.0"]] [lein-environ "1.1.0"]]
@ -28,7 +30,7 @@
["uberjar"] ["uberjar"]
["change" "version" "leiningen.release/bump-version"] ["change" "version" "leiningen.release/bump-version"]
["vcs" "commit"]] ["vcs" "commit"]]
:source-paths ["src/clojure"]
:target-path "target/%s" :target-path "target/%s"
:url "https://github.com/simon-brooke/the-great-game" :url "https://github.com/simon-brooke/beowulf"
) )

38
src/beowulf/host.clj
View file

@ -1,38 +0,0 @@
(ns beowulf.host
"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.")
;; these are CANDIDATES to be host-implemented. only a subset of them MUST be.
;; those which can be implemented in Lisp should be, since that aids
;; portability.
;; RPLACA
;; RPLACD
;; PLUS
;; MINUS
;; DIFFERENCE
;; QUOTIENT
;; REMAINDER
;; ADD1
;; SUB1
;; MAX
;; MIN
;; RECIP
;; FIXP
;; NUMBERP
;;

0
src/beowulf/bootstrap.clj → src/clojure/beowulf/bootstrap.clj
View file

45
src/beowulf/cons_cell.clj → src/clojure/beowulf/cons_cell.clj
View file

@ -3,20 +3,43 @@
Lisp 1.5 lists do not necessarily have a sequence as their CDR, so Lisp 1.5 lists do not necessarily have a sequence as their CDR, so
cannot be implemented on top of Clojure lists.") cannot be implemented on top of Clojure lists.")
(def NIL ;; (def NIL
"The canonical empty list symbol." ;; "The canonical empty list symbol."
(symbol "NIL")) ;; 'NIL)
(def T ;; (def T
"The canonical true value." ;; "The canonical true value."
(symbol "T")) ;; true. ;; 'T) ;; true.
(def F ;; (def F
"The canonical false value - different from `NIL`, which is not canonically ;; "The canonical false value - different from `NIL`, which is not canonically
false in Lisp 1.5." ;; false in Lisp 1.5."
(symbol "F")) ;; false as distinct from nil ;; 'F) ;; false as distinct from nil
(deftype ConsCell [^:unsynchronized-mutable car ^:unsynchronized-mutable cdr]
;; Note that, because the CAR and CDR fields are unsynchronised mutable - i.e.
;; plain old Java instance variables which can be written as well as read -
;; ConsCells are NOT thread safe. This does not matter, since Lisp 1.5 is
;; single threaded.
(CAR [this] (.car this))
(CDR [this] (.cdr this))
(RPLACA
[this value]
(if
(or
(instance? beowulf.cons_cell.ConsCell value)
(number? value)
(symbol? value)
(= value NIL))
(do
(set! (. cell CAR) value)
cell)
(throw (ex-info
(str "Invalid value in RPLACA: `" value "` (" (type value) ")")
{:cause :bad-value
:detail :rplaca}))))
(deftype ConsCell [CAR CDR]
clojure.lang.ISeq clojure.lang.ISeq
(cons [this x] (ConsCell. x this)) (cons [this x] (ConsCell. x this))
(first [this] (.CAR this)) (first [this] (.CAR this))

0
src/beowulf/core.clj → src/clojure/beowulf/core.clj
View file

61
src/clojure/beowulf/host.clj Normal file
View file

@ -0,0 +1,61 @@
(ns beowulf.host
"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 [make-beowulf-list make-cons-cell NIL T F]]))
;; these are CANDIDATES to be host-implemented. only a subset of them MUST be.
;; those which can be implemented in Lisp should be, since that aids
;; portability.
;; RPLACA
(defn RPLACA
[^beowulf.cons_cell.ConsCell cell value]
(if
(instance? beowulf.cons_cell.ConsCell cell)
(if
(or
(instance? beowulf.cons_cell.ConsCell value)
(number? value)
(symbol? value)
(= value NIL))
(do
(set! (. cell CAR) value)
cell)
(throw (ex-info
(str "Invalid value in RPLACA: `" value "` (" (type value) ")")
{:cause :bad-value
:detail :rplaca})))
(throw (ex-info
(str "Invalid cell in RPLACA: `" cell "` (" (type cell) ")")
{:cause :bad-value
:detail :rplaca}))))
;; RPLACD
;; PLUS
;; MINUS
;; DIFFERENCE
;; QUOTIENT
;; REMAINDER
;; ADD1
;; SUB1
;; MAX
;; MIN
;; RECIP
;; FIXP
;; NUMBERP
;;

0
src/beowulf/read.clj → src/clojure/beowulf/read.clj
View file

246
src/java/beowulf/substrate/ConsCell.java Normal file
View file

@ -0,0 +1,246 @@
package beowulf.substrate;
import clojure.lang.*;
import java.lang.Number;
import beowulf.cons_cell.NIL;
/**
* <p>
* A cons cell - a tuple of two pointers - is the fundamental unit of Lisp store.
* </p>
* <p>
* Implementing mutable data in Clojure if <em>hard</em> - deliberately so.
* But Lisp 1.5 cons cells need to be mutable. This class is part of thrashing
* around trying to find a solution.
* </p>
*/
public class ConsCell
implements clojure.lang.IPersistentCollection,
clojure.lang.ISeq,
clojure.lang.Seqable,
clojure.lang.Sequential {
/**
* The car of a cons cell can't be just any object; it needs to be
* a number, a symbol or a cons cell. But as there is no common superclass
* or interface for those things, we use Object here and specify the
* types of objects which can be stored in the constructors and setter
* methods.
*/
private Object car;
/**
* The car of a cons cell can't be just any object; it needs to be
* a number, a symbol or a cons cell. But as there is no common superclass
* or interface for those things, we use Object here and specify the
* types of objects which can be stored in the constructors and setter
* methods.
*/
private Object cdr;
public ConsCell(ConsCell car, ConsCell cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(ConsCell car, Symbol cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(ConsCell car, Number cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(Symbol car, ConsCell cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(Symbol car, Symbol cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(Symbol car, Number cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(Number car, ConsCell cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(Number car, Symbol cdr) {
this.car = car;
this.cdr = cdr;
}
public ConsCell(Number car, Number cdr) {
this.car = car;
this.cdr = cdr;
}
public Object getCar() {
return this.car;
}
public Object getCdr() {
return this.cdr;
}
public ConsCell setCar(ConsCell c) {
this.car = c;
return this;
}
public ConsCell setCdr(ConsCell c) {
this.cdr = c;
return this;
}
public ConsCell setCar(java.lang.Number n) {
this.car = n;
return this;
}
public ConsCell setCdr(java.lang.Number n) {
this.cdr = n;
return this;
}
public ConsCell setCar(clojure.lang.Symbol s) {
this.car = s;
return this;
}
public ConsCell setCdr(clojure.lang.Symbol s) {
this.cdr = s;
return this;
}
@Override
public boolean equals(Object other) {
boolean result;
if (other instanceof IPersistentCollection) {
ISeq s = ((IPersistentCollection) other).seq();
result = this.car.equals(s.first()) &&
this.cdr instanceof ConsCell &&
((ISeq) this.cdr).equiv(s.more());
} else {
result = false;
}
return result;
}
@Override
public String toString() {
StringBuilder bob = new StringBuilder("(");
for (Object d = this; d instanceof ConsCell; d = ((ConsCell)d).cdr) {
ConsCell cell = (ConsCell)d;
bob.append(cell.car.toString())
if ( cell.cdr instanceof ConsCell) {
bob.append(" ");
} else if ( cell.cdr.toString().equals("NIL")) {
/* That's an ugly hack to work around the fact I can't currently
* get a handle on the NIL symbol itself. In theory, nothing else
* in Lisp 1.5 should have the print-name `NIL`.*/
bob.append(")");
} else {
bob.append(" . ").append(cell.cdr.toString()).append(")");
}
}
return bob.toString();
}
/* IPersistentCollection interface implementation */
public int count() {
return this.cdr instanceof ConsCell ?
1 + ((ConsCell) this.cdr).count() :
1;
}
/**
* `empty` is completely undocumented, I'll return `null` until something breaks.
*/
public IPersistentCollection empty() {
return null;
}
/**
* God alone knows what `equiv` is intended to do; it's completely
* undocumented. But in PersistentList it's simply a synonym for 'equals',
* and that's what I'll implement.
*/
public boolean equiv(Object o) {
return this.equals(o);
}
/* ISeq interface implementation */
public Object first() {
return this.car;
}
public ISeq next() {
ISeq result;
if (this.cdr instanceof ConsCell) {
result = (ISeq) this.cdr;
} else {
result = null;
}
return result;
}
public ISeq more() {
ISeq result;
if (this.cdr instanceof ConsCell) {
result = (ISeq) this.cdr;
} else {
result = null;
}
return result;
}
/**
* Return a new cons cell comprising the object `o` as car,
* and myself as cdr. Hopefully by declaring the return value
* `ConsCell` I'll satisfy both the IPersistentCollection and the
* ISeq interfaces.
*/
public ConsCell cons(Object o) {
if (o instanceof ConsCell) {
return new ConsCell((ConsCell) o, this);
} else if (o instanceof Number) {
return new ConsCell((Number) o, this);
} else if (o instanceof Symbol) {
return new ConsCell((Symbol) o, this);
} else {
throw new IllegalArgumentException("Unrepresentable argument passed to CONS");
}
}
/* Seqable interface */
public ISeq seq() {
return this;
}
/* Sequential interface is just a marker and does not require us to
* implement anything */
}

18
test/beowulf/host_test.clj Normal file
View file

@ -0,0 +1,18 @@
(ns beowulf.host-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.host :refer :all]
[beowulf.read :refer [gsp]]))
(deftest destructive-change-test
(testing "RPLACA"
(let
[l (make-beowulf-list '(A B C D E))
target (.CDR l)
expected "(A F C D E)"
actual (print-str (RPLACA target 'F))]
(is (= actual expected)))
))