~subsetpark/ec

ref: cb9047649f01b15e78a1cd66b6dc710c38792038 ec/src/adverbs.janet -rw-r--r-- 1.8 KiB
cb904764 — Zach Smith Add some more useful adverbs 10 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
(import /src/calc)

(defmacro defadv
  [name arity & body]
  ~(def ,name (:new calc/Adverb
                    :arity ,arity
                    :type ,(keyword name)
                    :fun-ref (fn ,name [stack] ,;body))))

(defadv distribute-dyad 3
  (let [quotation (calc/pop stack)
        object (calc/pop stack)]
    # Leave the initial value on the stack.

    (unless (calc/Quotation? quotation)
      (errorf "Distribute error: top argument must be a quotation"))

    (each elem (calc/data object)
      (calc/push stack elem)

      (calc/check-arity stack quotation)

      (each verb-elem (calc/data quotation)
        (calc/push stack verb-elem)))))

(defadv apply-quotation 1
  (let [quotation (calc/pop stack)]
    (if (calc/Quotation? quotation)
      (do (calc/check-arity stack quotation)
        (each elem (calc/data quotation)
          (calc/push stack elem)))
      (calc/push stack quotation))))

(defadv wrap-stack 0
  (let [v (calc/wrap ;(stack :data))]
    (array/clear (stack :data))
    (calc/push stack v)))

(defadv clear-stack 0
  (array/clear (stack :data)))

(defadv swap 2
  (let [top (calc/pop stack)
        second (calc/pop stack)]
    (calc/push stack top)
    (calc/push stack second)))

(defadv slurp 2
  (let [elem (calc/pop stack)
        quotation (calc/pop stack)
        new-quotation (if (calc/Quotation? quotation)
                        (calc/wrap ;(quotation :data) elem)
                        (calc/wrap quotation elem))]
    (calc/push stack new-quotation)))

(defadv slurp-left 2
  (let [quotation (calc/pop stack)
        elem (calc/pop stack)
        new-quotation (if (calc/Quotation? quotation)
                        (calc/wrap elem ;(quotation :data))
                        (calc/wrap elem quotation))]
    (calc/push stack new-quotation)))