~subsetpark/ec

44a6ba6184d2b3db8c8fe52700f7952781706c9e — Zach Smith 9 months ago ffc6859
Some cleanup around truncate
6 files changed, 50 insertions(+), 32 deletions(-)

M main.janet
M src/operations.janet
M src/parser.janet
M src/print.janet
A test/print.janet
M test/regressions.janet
M main.janet => main.janet +1 -21
@@ 55,32 55,12 @@
      @[:special patt] (handle-special s patt)
      _ (calc/push s token))))

(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]
  (var buf (buffer peek))
  (var last-length (length buf))
  
  (reverse! buf)
  
  (while (> (length buf) 40)
    (set buf (tracev (peg/replace delimiters-peg "..." buf)))
    (if (= (length buf) last-length) (break))
    (set last-length (length buf)))
  
  (string (reverse! buf)))

(defn- prompt
  [s]
  (->> s
       (calc/peek)
       (print/p)
       (truncate)
       (print/truncate)
       (string/format "<%s> $ ")))

(defn repl

M src/operations.janet => src/operations.janet +2 -2
@@ 14,7 14,7 @@
  ~(defop ,name ,arity ,out-arity
     (fn [x y] (if (,cmp x y) 1 0))
     (string/format
      `x y -- p
       `x y -- p
       Comparison predicate.
       Push 1 if x %s y;
       else 0.


@@ 29,7 29,7 @@
  Push -1 if x < y;
        0 if x = y;
        1 if x > y.
  ` )
  `)
(defop pow 2 1 math/pow)
(defop sqrt 1 1 math/sqrt)


M src/parser.janet => src/parser.janet +8 -8
@@ 65,14 65,14 @@
        (errorf "syntax error: unknown word %s" patt))))

(def- peg (peg/compile
           ~{:main (any (+ :s+ :quotes :vectors :token))
             :quotes (cmt (* "(" :main ")") ,handle-quotes)
             :vectors (cmt (* "[" :main "]") ,handle-vectors)
             :number-part (some (+ :d "_"))
             :float (cmt (<- (* (? "-") :number-part "." :number-part)) ,handle-float)
             :int (cmt (<- (* (? "-") :number-part)) ,handle-int)
             :word (cmt (<- (some (if-not (+ :s (set "()[]")) 1))) ,handle-word)
             :token (+ :float :int :word)}))
            ~{:main (any (+ :s+ :quotes :vectors :token))
              :quotes (cmt (* "(" :main ")") ,handle-quotes)
              :vectors (cmt (* "[" :main "]") ,handle-vectors)
              :number-part (some (+ :d "_"))
              :float (cmt (<- (* (? "-") :number-part "." :number-part)) ,handle-float)
              :int (cmt (<- (* (? "-") :number-part)) ,handle-int)
              :word (cmt (<- (some (if-not (+ :s (set "()[]")) 1))) ,handle-word)
              :token (+ :float :int :word)}))

(defn parse
  [str]

M src/print.janet => src/print.janet +24 -0
@@ 31,3 31,27 @@

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

A test/print.janet => test/print.janet +14 -0
@@ 0,0 1,14 @@
(import /src/print)

(use testament)
(use /test-support)

(deftest truncate
  (is (= "(...)" (print/truncate "(xxxx)" 5)))
  (is (= "[...]" (print/truncate "[xxxx]" 5)))
  (is (= "xxxxxx" (print/truncate "xxxxxx" 5)))

  (is (= "xxx (...)" (print/truncate "xxx (xxxxx)" 10)))
  (is (= "xxx (x)" (print/truncate "xxx (x)" 5))))

(run-tests!)

M test/regressions.janet => test/regressions.janet +1 -1
@@ 66,5 66,5 @@
  # Push [2 1] fill
  # => [[4 4]]
  (is (= "[[2] [2]] [[4] [4]]" (print/p (s :data)))))
  # I think this is right but I don't fully understand it.
# I think this is right but I don't fully understand it.
(run-tests!)