~subsetpark/ec

b0fefebb3537ec20d7a4077c0c17c05f9082d055 — Zach Smith 3 months ago c337846 v0.4.3
Add scan and range
2 files changed, 94 insertions(+), 29 deletions(-)

M src/compose.janet
M src/env.janet
M src/compose.janet => src/compose.janet +19 -1
@@ 89,7 89,25 @@
(defcompose length 1
  ```
  q -- n
  Push the length of a quotation or vector.
  push the length of a quotation or vector.
  ```
  adverbs/shape
  adverbs/quotation-first)

(defcompose sum 1
  ```
  q -- n
  sum a quotation or vector.
  ```
  (:new calc/Int 0)
  (calc/quote-wrap operations/add)
  adverbs/dist)

(defcompose product 1
  ```
  q -- n
  find the product of a quotation or vector.
  ```
  (:new calc/Int 1)
  (calc/quote-wrap operations/mul)
  adverbs/dist)

M src/env.janet => src/env.janet +75 -28
@@ 59,7 59,9 @@
                  "quote-all" compose/quote-all
                  "wrap-all" compose/wrap-all
                  "swop" compose/swop
                  "length" compose/length})
                  "length" compose/length
                  "sum" compose/sum
                  "product" compose/product})

(defn new-env
  [&opt proto]


@@ 67,8 69,9 @@
  (let [s (:new calc/Stack)]
    (put s :env (table/setproto @{} proto))))

(adverbs/defadv map-vector 2
                ```
(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.


@@ 77,38 80,82 @@
  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))]
  (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))
    (each elem (calc/data v)
      (calc/push substack elem)
      (eval/apply-quotation substack q))

                  (calc/push stack (calc/wrap ;(substack :data)))))
    (calc/push stack (calc/wrap ;(substack :data)))))

(put dictionary "map" map-vector)

(adverbs/defadv fork 3
                ```
(adverbs/defadv
  scan-vector 3
  ```
  v a q -- w
  Insert `a`, then apply quotation `q` after every element of `v`.

  Collect the top element of the stack after each application into a
  new vector.
  ```
  (let [q (calc/pop stack)
        base (calc/pop stack)
        v (calc/pop stack)
        substack (new-env (stack :env))
        return (new-env (stack :env))]

    (calc/push substack base)
    (each elem (calc/data v)
      (calc/push substack elem)
      (eval/apply-quotation substack q)
      (calc/push return (calc/peek substack)))

    (calc/push stack (calc/wrap ;(return :data)))))

(put dictionary "scan" scan-vector)

(adverbs/defadv
  fork 3
  ```
  S a q p -- S a' a'' 
  Apply q to a, and p to a, and push the results on the stack.
  ```
                (let [p (calc/pop stack)
                      q (calc/pop stack)
                      a (calc/pop stack)
                      p-env (new-env (stack :env))
                      q-env (new-env (stack :env))]
                  # Thread 1
                  (calc/push p-env a)
                  (eval/apply-quotation p-env p)
                  # Thread 2
                  (calc/push q-env a)
                  (eval/apply-quotation q-env q)
                  # Main Thread
                  (each elem (q-env :data)
                    (calc/push stack elem))
                  (each elem (p-env :data)
                    (calc/push stack elem))))
  (let [p (calc/pop stack)
        q (calc/pop stack)
        a (calc/pop stack)
        p-env (new-env (stack :env))
        q-env (new-env (stack :env))]
    # Thread 1
    (calc/push p-env a)
    (eval/apply-quotation p-env p)
    # Thread 2
    (calc/push q-env a)
    (eval/apply-quotation q-env q)
    # Main Thread
    (each elem (q-env :data)
      (calc/push stack elem))
    (each elem (p-env :data)
      (calc/push stack elem))))

(put dictionary "fork" fork)

(compose/defcompose
  range 1
  ```
  n -- v
  generate a vector with numbers 0 up to `n`.
 
  1 swap wrap fill 0 (+) scan
  ```
  (:new calc/Int 1)
  adverbs/swap
  compose/wrap-1
  adverbs/fill
  (:new calc/Int -1)
  (calc/quote-wrap operations/add)
  scan-vector)

(put dictionary "range" range)