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