~subsetpark/ec

9ce643616208141858b04673d6fcf444b0fee4e9 — Zach Smith 7 months ago f773a5d
Add linrec
3 files changed, 61 insertions(+), 12 deletions(-)

M src/adverbs.janet
M src/calc.janet
M src/env.janet
M src/adverbs.janet => src/adverbs.janet +42 -12
@@ 18,19 18,22 @@
  (let [quotation (calc/pop stack)]
    (eval/apply-quotation stack quotation)))

(defadv do-each 2
(defadv do-each 3
  ```
  S v q -- S
  Insert the contents of quotation `q` in between every element of
  `v`. If `v` is not a quotation, then `each` is equivalent to
  `apply`.
  S v a q -- S
  Insert `a`, then the contents of quotation `q` in between every
  element of `v`. If `v` is not a quotation, then `each` is equivalent
  to `apply`.
  ```
  (let [q (calc/pop stack)
        quotation (if (calc/Quotation*? q)
                    q
                    (calc/quote-wrap q))
        base (calc/pop stack)
        v (calc/pop stack)]

    
    (calc/push stack base)
    
    (if (calc/Quotation*? v)
      (each elem (calc/data v)
        (calc/push stack elem)


@@ 171,9 174,9 @@
    (eval/apply-quotation stack qp)

    (let [result (calc/pop stack)]
      (case (result :value)
        0 (eval/apply-quotation stack qf)
        (eval/apply-quotation stack qt)))))
      (if (calc/is-true? result)
        (eval/apply-quotation stack qt)
        (eval/apply-quotation stack qf)))))

(defadv pop 1
  ```


@@ 185,12 188,12 @@
(defn primitive-recursion
  [stack operation zero]
  (let [data (calc/peek stack)]
    (if (zero? (data :value))
    (if (calc/null? data)
      (do
        (calc/pop stack)
        (eval/apply-quotation stack zero))
      (do
        (calc/push stack (:new (table/getproto data) (dec (data :value))))
        (calc/push stack (calc/pred data))
        (primitive-recursion stack operation zero)
        (eval/apply-quotation stack operation)))))



@@ 199,7 202,7 @@
  Primitive recursion.

  S d zq oq -- S
  > If the data parameter is zero, then the first quotation has to
  > If the data parameter is [zero or empty], 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.


@@ 208,3 211,30 @@
  (let [operation-param (calc/pop stack)
        zero-param (calc/pop stack)]
    (primitive-recursion stack operation-param zero-param)))

(defn linear-recursion
  [stack if-q then else else2]
  
  (calc/push stack dup)
  (eval/apply-quotation stack if-q)
  
  (let [if-result (calc/pop stack)]
    (if (calc/is-true? if-result)
      (eval/apply-quotation stack then)
      (do
        (eval/apply-quotation stack else)
        (linear-recursion stack if-q then else else2)
        (eval/apply-quotation stack else2)))))

(defadv linrec 4
  ```
  S d if then else else2 -- S
  Duplicate `d` and apply `if`. If the result is true, apply
  `then`. Otherwise, apply `else` and recurse. After recursion, apply
  `else2`.
  ```
  (let [else2 (calc/pop stack)
        else (calc/pop stack)
        then (calc/pop stack)
        if-q (calc/pop stack)]
    (linear-recursion stack if-q then else else2)))

M src/calc.janet => src/calc.janet +18 -0
@@ 17,6 17,10 @@
  type {:allocate-value :float}
  value {:init? true})

(defmethod is-true? Number
  [n]
  (not (zero? (n :value))))

(defproto Symbol Element
  value {:init? true}
  quoted? {:default false})


@@ 42,6 46,20 @@
  data {:init? true}
  type {:allocate-value :thunk})

(defmethod null? Number
  [n] (zero? (n :value)))

(defmethod null? Quotation
  [q] (empty? (q :data)))

(defmethod pred Number
  [n] (:new (table/getproto n) (- (n :value) 1)))

(defmethod pred Quotation
  [q]
  (let [rest (array/slice (q :data) 1)]
    (:new (table/getproto q) ;rest)))

(defgeneric get-shape [elem]
  (errorf "Shape error: attempted vector operation on a %s"
          ((table/getproto elem) :_name)))

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