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))