1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
(use fugue)
(import /src/calc)
(import /src/parser)
(import /src/operations)
(import /src/adverbs)
(defmulti p [calc/Int]
[n] (string (n :value)))
(defmulti p [calc/Float]
[n] (string (n :value)))
(defmulti p [operations/Operation]
[o] (string (o :type)))
(defmulti p [adverbs/Adverb]
[a] (string (a :type)))
(defmulti p [parser/Symbol]
[{:value value}] value)
(varfn join [q] nil)
(defmulti p [calc/Quotation] [q] (join q "(" ")"))
(defmulti p [calc/Vector] [v] (join v "[" "]"))
(varfn join
[q l r]
(let [inner (map p (q :data))]
(string l (string/join inner " ") r)))
(defmulti p [:nil] [_] "")
(defmulti p [:array] [t] (string/join (map p t) " "))
(defmulti p [_]
[val] (describe val))
(def- max-width 40)
(def- delimiters-peg (peg/compile
~{:main (+ :parens :brackets)
:parens (* (look -1 ")") (not "...") (to "("))
:brackets (* (look -1 "]") (not "...") (to "["))}))
(defn truncate
[peek &opt width]
(default width max-width)
(var buf (buffer peek))
(var last-length (length buf))
(reverse! buf)
(while (> (length buf) width)
(let [replacement (peg/replace delimiters-peg "..." buf)]
(if (>= (length replacement) last-length)
(break)
(do (set last-length (length buf))
(set buf replacement)))))
(string (reverse! buf)))