~subsetpark/ec

0c23e095e080d0f7410a0329554694e853ab4d6b — Zach Smith 7 months ago 5f2065e
Give adverbs infinite out-arity
3 files changed, 9 insertions(+), 5 deletions(-)

M src/adverbs.janet
M src/calc.janet
M src/parser.janet
M src/adverbs.janet => src/adverbs.janet +1 -1
@@ 157,7 157,7 @@
(defadv if 3
  ```
  qt qf p -- x
  If `p` = 0, applies the quotation `qf`.
  If `p` = 0, applies `qf`.
     else applies `qt`.
 ```
  (let [p (calc/pop stack)

M src/calc.janet => src/calc.janet +7 -4
@@ 25,7 25,7 @@
(defproto Adverb Element
  type {}
  arity {}
  out-arity {})
  out-arity {:allocate-value math/inf})

(defproto Quotation Element
  out-arity {:allocate-value 1}


@@ 47,13 47,16 @@
(defmethod get-arity Operation [a] (a :arity))
(defmethod get-arity Quotation [q]
  (def arities @[])
  
  (loop [i :range [0 (length (q :data))]]
    (if (zero? i)
      (array/push arities (get-arity ((q :data) i)))
      (array/push arities
                  (get-arity (get-in q [:data i])))
      (array/push arities
                  (+ (last arities)
                     (- (get-arity ((q :data) i))
                        (((q :data) (dec i)) :out-arity))))))
                     (- (get-arity (get-in q [:data i]))
                        (get-in q [:data (dec i) :out-arity]))))))

  (max ;arities))

(defmethod fill Number

M src/parser.janet => src/parser.janet +1 -0
@@ 26,6 26,7 @@
                 "slurp" adverbs/slurp
                 "slurpl" adverbs/slurp-left
                 "slurpr" adverbs/slurp
                 "clear" adverbs/clear-stack
                 "c" adverbs/clear-stack
                 "fill" adverbs/fill
                 "dup" adverbs/dup