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

Added rplaca as a method - this does not work.

Browse source
This commit is contained in:
Simon Brooke 2019-08-22 19:16:36 +01:00
parent fd7cc71480
commit ffa3ecd1fe
2 changed files with 95 additions and 78 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/
*~

171
src/beowulf/cons_cell.clj
View file

@ -3,20 +3,35 @@
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")) ;; (symbol "NIL"))
(def T ;; (def T
"The canonical true value." ;; "The canonical true value."
(symbol "T")) ;; true. ;; (symbol "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 ;; (symbol "F")) ;; false as distinct from nil
(deftype ConsCell [^:unsynchronized-mutable CAR ^:unsynchronized-mutable CDR]
(rplaca [this value]
(if
(or
(instance? beowulf.cons_cell.ConsCell value)
(number? value)
(symbol? value))
(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))
@ -62,77 +77,77 @@
(= (rest this) (rest other)))) (= (rest this) (rest other))))
false))) false)))
(defn- to-string ;; (defn- to-string
"Printing ConsCells gave me a *lot* of trouble. This is an internal function ;; "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 ;; used by the print-method override (below) in order that the standard Clojure
`print` and `str` functions will print ConsCells correctly. The argument ;; `print` and `str` functions will print ConsCells correctly. The argument
`cell` must, obviously, be an instance of `ConsCell`." ;; `cell` must, obviously, be an instance of `ConsCell`."
[cell] ;; [cell]
(loop [c cell ;; (loop [c cell
n 0 ;; n 0
s "("] ;; s "("]
(if ;; (if
(instance? beowulf.cons_cell.ConsCell c) ;; (instance? beowulf.cons_cell.ConsCell c)
(let [car (.CAR c) ;; (let [car (.CAR c)
cdr (.CDR c) ;; cdr (.CDR c)
cons? (instance? beowulf.cons_cell.ConsCell cdr) ;; cons? (instance? beowulf.cons_cell.ConsCell cdr)
ss (str ;; ss (str
s ;; s
(to-string car) ;; (to-string car)
(cond ;; (cond
cons? ;; cons?
" " ;; " "
(or (nil? cdr) (= cdr 'NIL)) ;; (or (nil? cdr) (= cdr 'NIL))
")" ;; ")"
:else ;; :else
(str " . " (to-string cdr) ")")))] ;; (str " . " (to-string cdr) ")")))]
(if ;; (if
cons? ;; cons?
(recur cdr (inc n) ss) ;; (recur cdr (inc n) ss)
ss)) ;; ss))
(str c)))) ;; (str c))))
(defn pretty-print ;; (defn pretty-print
"This isn't the world's best pretty printer but it sort of works." ;; "This isn't the world's best pretty printer but it sort of works."
([^beowulf.cons_cell.ConsCell cell] ;; ([^beowulf.cons_cell.ConsCell cell]
(println (pretty-print cell 80 0))) ;; (println (pretty-print cell 80 0)))
([^beowulf.cons_cell.ConsCell cell width level] ;; ([^beowulf.cons_cell.ConsCell cell width level]
(loop [c cell ;; (loop [c cell
n (inc level) ;; n (inc level)
s "("] ;; s "("]
(if ;; (if
(instance? beowulf.cons_cell.ConsCell c) ;; (instance? beowulf.cons_cell.ConsCell c)
(let [car (.CAR c) ;; (let [car (.CAR c)
cdr (.CDR c) ;; cdr (.CDR c)
cons? (instance? beowulf.cons_cell.ConsCell cdr) ;; cons? (instance? beowulf.cons_cell.ConsCell cdr)
print-width (count (print-str c)) ;; print-width (count (print-str c))
indent (apply str (repeat n " ")) ;; indent (apply str (repeat n " "))
ss (str ;; ss (str
s ;; s
(pretty-print car width n) ;; (pretty-print car width n)
(cond ;; (cond
cons? ;; cons?
(if ;; (if
(< (+ (count indent) print-width) width) ;; (< (+ (count indent) print-width) width)
" " ;; " "
(str "\n" indent)) ;; (str "\n" indent))
(or (nil? cdr) (= cdr 'NIL)) ;; (or (nil? cdr) (= cdr 'NIL))
")" ;; ")"
:else ;; :else
(str " . " (pretty-print cdr width n) ")")))] ;; (str " . " (pretty-print cdr width n) ")")))]
(if ;; (if
cons? ;; cons?
(recur cdr n ss) ;; (recur cdr n ss)
ss)) ;; ss))
(str c))))) ;; (str c)))))
(defmethod clojure.core/print-method ;; (defmethod clojure.core/print-method
;;; I have not worked out how to document defmethod without blowing up the world. ;; ;;; I have not worked out how to document defmethod without blowing up the world.
beowulf.cons_cell.ConsCell ;; beowulf.cons_cell.ConsCell
[this writer] ;; [this writer]
(.write writer (to-string this))) ;; (.write writer (to-string this)))
(defmacro make-cons-cell (defmacro make-cons-cell