f773a5de302bffe5db466ce17f689f81c64b43b3 — Zach Smith 7 months ago 8cff5ac
primrec + fac
3 files changed, 43 insertions(+), 7 deletions(-)

M src/adverbs.janet
M src/compose.janet
M src/env.janet
M src/adverbs.janet => src/adverbs.janet +27 -0
@@ 181,3 181,30 @@
  Pops the top element of the stack.
  (calc/pop stack))

(defn primitive-recursion
  [stack operation zero]
  (let [data (calc/peek stack)]
    (if (zero? (data :value))
        (calc/pop stack)
        (eval/apply-quotation stack zero))
        (calc/push stack (:new (table/getproto data) (dec (data :value))))
        (primitive-recursion stack operation zero)
        (eval/apply-quotation stack operation)))))

(defadv primrec 3
  Primitive recursion.

  S d zq oq -- S
  > If the data parameter is zero, then the first quotation has to
  > produce the value to be returned. If the data parameter is
  > positive then the second has to combine the data parameter with
  > the result of applying the function to its predecessor.
  Manfred von Thun, _Tutorial on Joy_
  (let [operation-param (calc/pop stack)
        zero-param (calc/pop stack)]
    (primitive-recursion stack operation-param zero-param)))

M src/compose.janet => src/compose.janet +8 -1
@@ 10,7 10,7 @@
                    :doc ,doc
                    :fun-ref (fn ,name [stack]
                               ,;(seq [word :in words]
                                      ~(calc/push stack ,word))))))
                                   ~(calc/push stack ,word))))))

(defcompose square 1

@@ 48,3 48,10 @@

(defcompose fac 1
  a -- b
  (calc/quote-wrap (:new calc/Int 1)) (calc/quote-wrap operations/mul) adverbs/primrec)

M src/env.janet => src/env.janet +8 -6
@@ 25,6 25,7 @@
                  "apply" adverbs/apply-quotation
                  "i" adverbs/apply-quotation
                  "if" adverbs/if
                  "primrec" adverbs/primrec
                  # Stack operations
                  "clear" adverbs/clear-stack
                  "c" adverbs/clear-stack

@@ 42,13 43,14 @@
                  "slurpr" adverbs/slurp
                  "shape" adverbs/shape
                  "concat" adverbs/concat

                  "def" eval/define

                  "dip" compose/dip
                  "sqr" compose/square
                  "abs" compose/abs
                  "wrap" compose/wrap-1})
                  "wrap" compose/wrap-1
                  "fac" compose/fac})

(defn new-env
  [&opt proto]

@@ 63,17 65,17 @@
  `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
  + `.
  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)