~subsetpark/ec

32fb47a265790f03d6024e74593aad9cb6bd07b9 — Zach Smith 9 months ago 8585fc0
Working REPL
6 files changed, 127 insertions(+), 44 deletions(-)

M main.janet
M src/adverbs.janet
M src/calc.janet
M src/parser.janet
M test/calc.janet
M test/parser.janet
M main.janet => main.janet +29 -1
@@ 1,5 1,33 @@
(import /src/calc)
(import /src/print)
(import /src/parser)

(defn display
  [data]
  (print (print/p data))
  "")

(defn display-all
  [stack]
  (let [inner (map print/p stack)]
    (print (string/join inner " ")))
  "")

(defn handle-commands
  [in s]
  (case (freeze (string/trim in))
    "." (display (calc/peek s))
    "p" (display (calc/pop s))
    "s" (display-all (s :data))
    in))

(defn main
  [args]
  (let [s (:new calc/Stack)]))
  (let [s (:new calc/Stack)]
    (while true
      (let [buf @""
            prompt (string/format "[%s]> " (print/p (calc/peek s)))
            in (getline prompt buf parser/dictionary)
            after-commands (handle-commands in s)
            parsed (parser/parse after-commands)]
        (calc/push-all s parsed)))))

M src/adverbs.janet => src/adverbs.janet +6 -1
@@ 16,7 16,12 @@
      (each verb-elem (calc/data quoted-verb)
        (calc/push stack verb-elem)))))

(defadv apply-operation 1
(defadv apply-vector 1
  (let [quoted-verb (calc/pop stack)]
    (each elem (calc/data quoted-verb)
      (calc/push stack elem))))

(defadv wrap-stack 0
  (let [v (calc/wrap ;(stack :data))]
    (array/clear (stack :data))
    (calc/push stack v)))

M src/calc.janet => src/calc.janet +6 -8
@@ 30,14 30,14 @@
  [self shape-to-fill]
  (let [x (array ;(shape self))
        y (array ;shape-to-fill)]
    

    (while (not (empty? x))
      (let [xi (array/pop x)
            yi (array/pop y)]
        (unless (= xi yi)
          (errorf "Shape error: can't fill vector with shape %q to %q"
                  (shape self) shape-to-fill))))
    

    (reduce (fn [acc length]
              (let [new-shape (tuple length ;(shape acc))
                    new-data (array/new-filled length acc)]


@@ 92,11 92,9 @@
            arity
            (size stack))))

(defn- make-element
  # TODO: Do we want to do something more sophisticated here?
  [elem]
  (cond (number? elem)
        (:new Float elem)))
# TODO: Do we want to do something more sophisticated here?
(defmulti make-element [:number] [n] (:new Float n))
(defmulti make-element [_] [v] v)

(defmulti push [Stack Operation]
  [self op]


@@ 106,7 104,7 @@
    (def buf @[])
    (loop [_ :range [0 arity]]
      (array/push buf (pop self)))
    

    (push self (make-element (apply-operation op ;buf)))))

(defmulti push [Stack _]

M src/parser.janet => src/parser.janet +22 -20
@@ 2,19 2,21 @@
(import /src/operations)
(import /src/adverbs)

(def- dictionary {"+" operations/add
                  "-" operations/sub
                  "*" operations/mul
                  "x" operations/mul
                  "%" operations/div
                  "sqrt" operations/sqrt
                  "/" adverbs/distribute-dyad
                  ">" operations/gt
                  "<" operations/lt
                  ">=" operations/gte
                  "<=" operations/lte
                  "=" operations/eq
                 "cmp" operations/cmp})
(def dictionary {"+" operations/add
                 "-" operations/sub
                 "*" operations/mul
                 "x" operations/mul
                 "%" operations/div
                 "sqrt" operations/sqrt
                 ">" operations/gt
                 "<" operations/lt
                 ">=" operations/gte
                 "<=" operations/lte
                 "=" operations/eq
                 "cmp" operations/cmp
                 "/" adverbs/distribute-dyad
                 "!" adverbs/apply-vector
                 "@" adverbs/wrap-stack})

(defn handle-parens
  [& patt]


@@ 38,13 40,13 @@
      (errorf "syntax error: unknown word %s" patt)))

(def- peg (peg/compile
           ~{:main (any (+ :s+ :brackets :token))
             :brackets (cmt (* "[" :main "]") ,handle-brackets)
             :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+ :brackets :token))
              :brackets (cmt (* "[" :main "]") ,handle-brackets)
              :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 test/calc.janet => test/calc.janet +57 -7
@@ 4,7 4,7 @@
(import /src/adverbs :prefix "a/")

(use testament)
  

(defn- rec-data [vec]
  (match vec
    {:data data} (map rec-data data)


@@ 25,7 25,7 @@
(deftest vectors
  (def v (wrap 1 2 3))
  (def v2 (wrap 2 5 10))
  

  (vec= [4 5 6] (calc/apply-operation o/add v (:new calc/Int 3)))
  (vec= [3 7 13] (calc/apply-operation o/add v v2))



@@ 37,14 37,14 @@
(deftest matrices
  (is (thrown? (wrap (wrap 1) (wrap 1 2)))
      "Inner vectors are of differing sizes")
  

  (def m (wrap (wrap 1 2 3)
               (wrap 4 5 6)))
  (is (= [2 3] (calc/get-shape m)))
  

  (def filled (calc/fill m [2 2 3]))
  (is (= [2 2 3] (calc/get-shape filled)))
  

  (vec= @[@[@[1 2 3]
            @[4 5 6]]
          @[@[1 2 3]


@@ 60,6 60,10 @@
            @[8 10 12]]]
        (calc/apply-operation o/add m filled)))

(defn- pop-and-compare
  [val s]
  (is (= val (calc/value (calc/pop s)))))

(deftest distribute-dyad-add
  (def s (:new calc/Stack))
  # Initial value


@@ 69,7 73,7 @@
  # Operator
  (calc/push s (wrap o/add))
  (calc/push s a/distribute-dyad)
  (is (= 6 (calc/value (calc/peek s)))))
  (pop-and-compare 6 s))

(deftest distribute-dyad-multiple-operations
  (def s (:new calc/Stack))


@@ 77,6 81,52 @@
  (calc/push s (wrap 1 2 3))
  (calc/push s (wrap 3 o/mul o/add))
  (calc/push s a/distribute-dyad)
  (is (= 18 (calc/value (calc/peek s)))))
  (pop-and-compare 18 s))

(deftest apply-vector
  (def s (:new calc/Stack))
  (calc/push s (wrap 1 2 3))
  (calc/push s a/apply-vector)
  (pop-and-compare 3 s)
  (pop-and-compare 2 s)
  (pop-and-compare 1 s)
  (is (empty? (s :data))))

(deftest apply-operation
  (def s (:new calc/Stack))
  (calc/push s (:new calc/Int 3))
  (calc/push s (:new calc/Int 5))
  (calc/push s (wrap o/add))
  (calc/push s a/apply-vector)
  (pop-and-compare 8 s)
  (is (empty? (s :data))))

(deftest wrap-stack
  (def s (:new calc/Stack))
  (calc/push s (:new calc/Int 3))
  (calc/push s (:new calc/Int 4))
  (calc/push s a/wrap-stack)

  (def vec (calc/pop s))
  (is (= [2] (calc/shape vec)))
  (is (empty? (s :data))))

(deftest wrap-vectors
  (def s (:new calc/Stack))
  (calc/push s (wrap 1 2))
  (calc/push s (wrap 2 4))
  (calc/push s a/wrap-stack)

  (def vec (calc/pop s))
  (is (= [2 2] (calc/shape vec)))
  (is (empty? (s :data))))

(deftest wrap-failure
  (def s (:new calc/Stack))
  (calc/push s (wrap 1))
  (calc/push s (wrap 2 4))
  (is (thrown?
        (calc/push s a/wrap-stack))
      "Wrapping a stack requires homogeneous data"))

(run-tests!)

M test/parser.janet => test/parser.janet +7 -7
@@ 16,16 16,16 @@
        [float] (parser/parse "5.0")
        [neg] (parser/parse "-5")
        [underscored] (parser/parse "5_000")]
    

    (is (= 5 (int :value)))
    (is (calc/Int? int))
    

    (is (= 5 (float :value)))
    (is (calc/Float? float))
    

    (is (= -5 (neg :value)))
    (is (calc/Int? neg))
    

    (is (= 5000 (underscored :value)))
    (is (calc/Int? underscored))))



@@ 41,7 41,7 @@
  (let [s (:new calc/Stack)
        parsed (parser/parse "4 5 +")]
    (calc/push-all s parsed)
    

    (is (= 1 (length (s :data))))
    (def res (first (s :data)))



@@ 51,8 51,8 @@
(deftest push-adverb
  (let [s (:new calc/Stack)
        parsed (parser/parse "0 [1 2 3] [+] /")]
    (calc/push-all s parsed)    
    
    (calc/push-all s parsed)

    (is (= 1 (length (s :data))))
    (def res (first (s :data)))