001 (ns beowulf.cons-cell
002 "The fundamental cons cell on which all Lisp structures are built.
003 Lisp 1.5 lists do not necessarily have a sequence as their CDR, so
004 cannot be implemented on top of Clojure lists.")
005
006 (def NIL
007 "The canonical empty list symbol."
008 (symbol "NIL"))
009
010 (def T
011 "The canonical true value."
012 (symbol "T")) ;; true.
013
014 (def F
015 "The canonical false value - different from `NIL`, which is not canonically
016 false in Lisp 1.5."
017 (symbol "F")) ;; false as distinct from nil
018
019 (deftype ConsCell [CAR CDR]
020 clojure.lang.ISeq
021 (cons [this x] (ConsCell. x this))
022 (first [this] (.CAR this))
023 ;; next and more must return ISeq:
024 ;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java
025 (more [this] (if
026 (seq? (.CDR this))
027 (.CDR this)
028 clojure.lang.PersistentList/EMPTY))
029 (next [this] (if
030 (seq? (.CDR this))
031 (.CDR this)
032 nil ;; next returns nil when empty
033 ))
034
035 clojure.lang.Seqable
036 (seq [this] this)
037
038 ;; for some reason this marker protocol is needed otherwise compiler complains
039 ;; that `nth not supported on ConsCell`
040 clojure.lang.Sequential
041
042 clojure.lang.IPersistentCollection
043 (count [this] (if
044 (coll? (.CDR this))
045 (inc (.count (.CDR this)))
046 1))
047 (empty [this] false) ;; a cons cell is by definition not empty.
048 (equiv [this other] (if
049 (seq? other)
050 (and
051 (if
052 (and
053 (seq? (first this))
054 (seq? (first other)))
055 (.equiv (first this) (first other))
056 (= (first this) (first other)))
057 (if
058 (and
059 (seq? (rest this))
060 (seq? (rest other)))
061 (.equiv (rest this) (rest other))
062 (= (rest this) (rest other))))
063 false)))
064
065 (defn- to-string
066 "Printing ConsCells gave me a *lot* of trouble. This is an internal function
067 used by the print-method override (below) in order that the standard Clojure
068 `print` and `str` functions will print ConsCells correctly. The argument
069 `cell` must, obviously, be an instance of `ConsCell`."
070 [cell]
071 (loop [c cell
072 n 0
073 s "("]
074 (if
075 (instance? beowulf.cons_cell.ConsCell c)
076 (let [car (.CAR c)
077 cdr (.CDR c)
078 cons? (instance? beowulf.cons_cell.ConsCell cdr)
079 ss (str
080 s
081 (to-string car)
082 (cond
083 cons?
084 " "
085 (or (nil? cdr) (= cdr 'NIL))
086 ")"
087 :else
088 (str " . " (to-string cdr) ")")))]
089 (if
090 cons?
091 (recur cdr (inc n) ss)
092 ss))
093 (str c))))
094
095 (defn pretty-print
096 "This isn't the world's best pretty printer but it sort of works."
097 ([^beowulf.cons_cell.ConsCell cell]
098 (println (pretty-print cell 80 0)))
099 ([^beowulf.cons_cell.ConsCell cell width level]
100 (loop [c cell
101 n (inc level)
102 s "("]
103 (if
104 (instance? beowulf.cons_cell.ConsCell c)
105 (let [car (.CAR c)
106 cdr (.CDR c)
107 cons? (instance? beowulf.cons_cell.ConsCell cdr)
108 print-width (count (print-str c))
109 indent (apply str (repeat n " "))
110 ss (str
111 s
112 (pretty-print car width n)
113 (cond
114 cons?
115 (if
116 (< (+ (count indent) print-width) width)
117 " "
118 (str "\n" indent))
119 (or (nil? cdr) (= cdr 'NIL))
120 ")"
121 :else
122 (str " . " (pretty-print cdr width n) ")")))]
123 (if
124 cons?
125 (recur cdr n ss)
126 ss))
127 (str c)))))
128
129
130
131 (defmethod clojure.core/print-method
132 ;;; I have not worked out how to document defmethod without blowing up the world.
133 beowulf.cons_cell.ConsCell
134 [this writer]
135 (.write writer (to-string this)))
136
137
138 (defmacro make-cons-cell
139 "Construct a new instance of cons cell with this `car` and `cdr`."
140 [car cdr]
141 `(ConsCell. ~car ~cdr))
142
143 (defn make-beowulf-list
144 "Construct a linked list of cons cells with the same content as the
145 sequence `x`."
146 [x]
147 (cond
148 (empty? x) NIL
149 (coll? x) (ConsCell.
150 (if
151 (seq? (first x))
152 (make-beowulf-list (first x))
153 (first x))
154 (make-beowulf-list (rest x)))
155 :else
156 NIL))