~subsetpark/ec

73fab722925dd8814ddc2568348f425e23bf245c — Zach Smith 6 months ago 4ed8711 smart-dist
small + wrap-1
4 files changed, 39 insertions(+), 28 deletions(-)

M src/adverbs.janet
M src/compose.janet
M src/operations.janet
M src/parser.janet
M src/adverbs.janet => src/adverbs.janet +3 -3
@@ 87,8 87,8 @@

(defadv wrap-stack 0
  ```
  (x) -- q
  Wrap the entire stack in a quotation. 
  (x) -- v
  Wrap the entire stack in a vector. 
  ```
  (let [v (calc/wrap ;(stack :data))]
    (array/clear (stack :data))


@@ 199,7 199,7 @@
        qp (calc/pop stack)]

    (do-apply stack qp)
    

    (let [result (calc/pop stack)]
      (case (result :value)
        0 (do-apply stack qf)

M src/compose.janet => src/compose.janet +3 -0
@@ 12,8 12,11 @@
                                   ~(calc/push stack ,word))))))

(defcompose square 1 adverbs/dup operations/mul)

(defcompose abs 1
  (calc/quote-wrap (:new calc/Int 0) operations/lt)
  (calc/quote-wrap (:new calc/Int 0) adverbs/swap operations/sub)
  (calc/quote-wrap)
  adverbs/if)

(defcompose wrap-1 1 (calc/wrap) adverbs/slurp-left)

M src/operations.janet => src/operations.janet +15 -13
@@ 8,19 8,6 @@
                    :fun-ref ,f
                    :doc ,doc)))

(defmacro defcmp
  [name arity cmp]
  ~(defop ,name ,arity
     (fn [x y] (if (,cmp x y) 1 0))
     (string/format
      `
      x y -- bool
      Comparison predicate.
      Push 1 if x %s y;
             else 0.
      `
      ,(string cmp))))

(defop add 2 +)
(defop sub 2 -)
(defop div 2 /)


@@ 34,6 21,21 @@
  `)
(defop pow 2 math/pow)
(defop sqrt 1 math/sqrt)
(defop small 1 |(or (= $ 0) (= $ 1))
  "x -- bool\nPush 1 if x is 0 or 1.")

(defmacro defcmp
  [name arity cmp]
  ~(defop ,name ,arity
     (fn [x y] (if (,cmp x y) 1 0))
     (string/format
       `
      x y -- bool
      Comparison predicate.
      Push 1 if x %s y;
             else 0.
      `
       ,(string cmp))))

(defcmp lt 2 <)
(defcmp gt 2 >)

M src/parser.janet => src/parser.janet +18 -12
@@ 16,29 16,35 @@
                 "=" operations/eq
                 "cmp" operations/cmp
                 "pow" operations/pow
                 "small" operations/small

                 "distribute" adverbs/distribute
                 "map" adverbs/map-quotation
                 # Combinators
                 "dist" adverbs/distribute
                 "/" adverbs/distribute
                 "map" adverbs/map-quotation
                 "apply" adverbs/apply-quotation
                 "i" adverbs/apply-quotation
                 "@" adverbs/wrap-stack
                 "swap" adverbs/swap
                 "slurp" adverbs/slurp
                 "slurpl" adverbs/slurp-left
                 "slurpr" adverbs/slurp
                 "if" adverbs/if
                 # Stack operations
                 "clear" adverbs/clear-stack
                 "c" adverbs/clear-stack
                 "fill" adverbs/fill
                 "swap" adverbs/swap
                 "dup" adverbs/dup
                 "arity" adverbs/arity
                 "shape" adverbs/shape
                 "if" adverbs/if
                 "pop" adverbs/pop
                 "dip" adverbs/dip
                 # Array logic-bypassing
                 "arity" adverbs/arity
                 "shape" adverbs/shape
                 # Quotation
                 "wrap-all" adverbs/wrap-stack
                 "fill" adverbs/fill
                 "slurp" adverbs/slurp
                 "slurpl" adverbs/slurp-left
                 "slurpr" adverbs/slurp

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

(defn handle-parens
  [& patt]