~subsetpark/ec

8cff5acaec376b285d4c07c3a64d709f6c3af4ae — Zach Smith 7 months ago d2f6c5b
concat, each, map
M src/adverbs.janet => src/adverbs.janet +12 -2
@@ 18,11 18,11 @@
  (let [quotation (calc/pop stack)]
    (eval/apply-quotation stack quotation)))

(defadv map-quotation 2
(defadv do-each 2
  ```
  S v q -- S
  Insert the contents of quotation `q` in between every element of
  `v`. If `v` is not a quotation, then `distribute` is equivalent to
  `v`. If `v` is not a quotation, then `each` is equivalent to
  `apply`.
  ```
  (let [q (calc/pop stack)


@@ 67,6 67,16 @@
        s (calc/quote-wrap ;(r :data) ;(q :data))]
    (calc/push stack s)))

(defadv concat 2
  ```
  v w -- v'
  Combine the top two vectors into a single vector.
  ```
  (let [q (calc/pop stack)
        r (calc/pop stack)
        s (calc/wrap ;(r :data) ;(q :data))]
    (calc/push stack s)))

(defadv clear-stack 0
  ```
  S -- <>

M src/calc.janet => src/calc.janet +1 -1
@@ 114,7 114,7 @@
        inner-shape (if hd (get-shape hd) ())]
    (each datum data
      (unless (deep= (get-shape datum) inner-shape)
        (errorf "Vector error: can't wrap heterogeneous data. Expected %j, got %j."
        (errorf "Vector error: can't wrap heterogeneous data. Expected shape %j, got %j."
                inner-shape
                (get-shape datum))))
    (:new Vector (tuple (length data) ;inner-shape) data)))

M src/env.janet => src/env.janet +28 -5
@@ 21,7 21,7 @@
                  "small" operations/small

                  # Combinators
                  "map" adverbs/map-quotation
                  "each" adverbs/do-each
                  "apply" adverbs/apply-quotation
                  "i" adverbs/apply-quotation
                  "if" adverbs/if


@@ 31,8 31,6 @@
                  "swap" adverbs/swap
                  "dup" adverbs/dup
                  "pop" adverbs/pop
                  # Vector logic-bypassing
                  "shape" adverbs/shape
                  # Quotation
                  "quote" adverbs/quote-element
                  "compose" adverbs/compose


@@ 42,6 40,8 @@
                  "slurp" adverbs/slurp
                  "slurpl" adverbs/slurp-left
                  "slurpr" adverbs/slurp
                  "shape" adverbs/shape
                  "concat" adverbs/concat
                  
                  "def" eval/define



@@ 51,6 51,29 @@
                  "wrap" compose/wrap-1})

(defn new-env
  []
  [&opt proto]
  (default proto dictionary)
  (let [s (:new calc/Stack)]
    (put s :env (table/setproto @{} dictionary))))
    (put s :env (table/setproto @{} proto))))

(adverbs/defadv map-vector 2
  ```
  v q -- v'
  Insert the contents of quotation `q` in between every element of
  `v`. Wrap the resulting elements in a vector.

  For ordinary operations, this is equivalent to applying them
  directly. For instance, `v (dup 1 +) map` is equivalent to `v dup 1
  + `.
  ```
  (let [q (calc/pop stack)
        v (calc/pop stack)
        substack (new-env (stack :env))]
      
    (each elem (calc/data v)
      (calc/push substack elem)
      (eval/apply-quotation substack q))
      
    (calc/push stack (calc/wrap ;(substack :data)))))

(put dictionary "map" map-vector)

M test/calc.janet => test/calc.janet +4 -4
@@ 44,17 44,17 @@
            @[8 10 12]]]
        (calc/apply-operation o/add m filled)))

(deftest map-add
(deftest each-add
  (def s (:new calc/Stack))
  (calc/push s (:new calc/Int 0))
  # Operands
  (calc/push s (wrap 1 2 3))
  # Operator
  (calc/push s (quote-wrap o/add))
  (calc/push s a/map-quotation)
  (calc/push s a/do-each)
  (pop-and-compare 6 s))

(deftest map-multiple-operations
(deftest each-multiple-operations
  (def s (:new calc/Stack))
  (calc/push s (:new calc/Int 0))
  (calc/push s (wrap 1 2 3))


@@ 66,7 66,7 @@
  # [3] 12
  # 12 3 4 * +
  # 24
  (calc/push s a/map-quotation)
  (calc/push s a/do-each)
  (pop-and-compare 24 s))

(deftest apply-quotation

M test/env.janet => test/env.janet +7 -0
@@ 42,4 42,11 @@
      (is (calc/Float? eleven))
      (is (= 11 (eleven :value))))))

(deftest map-vector
  (let [s (env/new-env)
        parsed (parser/parse "[1 2 3 4] (1 +) map")]
    (eval-all s parsed)
    (let [vec (calc/peek s)]
      (vec= [2 3 4 5] vec))))

(run-tests!)

M test/eval.janet => test/eval.janet +1 -1
@@ 22,7 22,7 @@

(deftest push-adverb
  (let [s (env/new-env)
        parsed (parser/parse "0 [1 2 3] (+) map")]
        parsed (parser/parse "0 [1 2 3] (+) each")]
    (eval-all s parsed)

    (is (= 1 (length (s :data))))

M test/regressions.janet => test/regressions.janet +1 -1
@@ 58,7 58,7 @@
(deftest regression5
  # .[.[2].[4]] [.[2 1] fill] /
  (def s (env/new-env))
  (let [in (parser/parse "[[2][4]] ([2 1] fill) map")]
  (let [in (parser/parse "[[2][4]] ([2 1] fill) each")]
    (eval-all s in))
  # Distribute `[2 1] fill`:
  # Push [2]