~subsetpark/ec

ref: d48e38e3de4186d9f151e3c349917750349ad837 ec/src/print.janet -rw-r--r-- 1.3 KiB
d48e38e3 — Zach Smith Use a proto instead of a tagged value 2 months ago
                                                                                
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
(use fugue)

(import /src/calc)
(import /src/parser)
(import /src/operations)
(import /src/adverbs)

(varfn join [q] nil)

(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)
(defmulti p [calc/Quotation] [q] (join q "(" ")"))
(defmulti p [calc/Vector] [v] (join v "[" "]"))
(defmulti p [:nil] [_] "")
(defmulti p [:array] [t] (string/join (map p t) " "))
(defmulti p [_] [val] (describe val))

(varfn join
  [q l r]
  (let [inner (map p (q :data))]
    (string l (string/join inner " ") r)))

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