~subsetpark/ec

ref: e85c9853e2f2332e47aaa381a543d0f78de5cd4e ec/src/adverbs.janet -rw-r--r-- 3.8 KiB
e85c9853 — Zach Smith test-arity helper 9 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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
(import /src/calc)

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

(defadv apply-quotation 1
  ```
  q -- x
  "Unwrap" a quotation and push its elements onto the stack.
  `1 1 (+) apply` is equivalent to `1 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 distribute 0
  ```
  v q -- x
  Insert the contents of quotation `q` in between every element of
  `v`. If `v` is not a quotation, then `distribute` is equivalent to
  `apply`.
  ```
  (let [q (calc/pop stack)
        quotation (if (calc/Quotation*? q)
                    q
                    (calc/quote-wrap q))
        v (calc/pop stack)]

    (defn push-verb []
      (calc/check-arity stack quotation)
      (each verb-elem (calc/data quotation)
        (calc/push stack verb-elem)))

    (if (calc/Quotation*? v)
      (each elem (calc/data v)
        (calc/push stack elem)
        (push-verb))
      (do
        (calc/push stack v)
        (push-verb)))))

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

(defadv clear-stack 0
  ```
  x -- 
  Clear the entire stack.
  ```
  (array/clear (stack :data)))

(defadv dup 1
  ```
  a --- a a
  Duplicate the top element on the stack.
  ```
  (let [top (calc/peek stack)]
    (calc/push stack top)))

(defadv swap 2
  ```
  a b -- b a
  Swap the two top elements on the stack.
  ```
  (let [top (calc/pop stack)
        second (calc/pop stack)]
    (calc/push stack top)
    (calc/push stack second)))

(defadv slurp 2
  ```
  q a -- q
  If the second element on the stack `q` is a quotation,
  includes the topmost element as the last item in `q`.

  If either element is a quotation, wraps the two top
  elements in a quotation.
  ```
  (let [elem (calc/pop stack)
        vector (calc/pop stack)
        new-vector (if (calc/Vector? vector)
                     (calc/wrap ;(vector :data) elem)
                     (calc/wrap vector elem))]
    (calc/push stack new-vector)))

(defadv slurp-left 2
  ```
  a q -- q
  If the topmost element on the stack `q` is a quotation,
  includes the second element as the first item in `q`.
  
  If either element is a quotation, wraps the two top
  elements in a quotation.
  ```
  (let [vector (calc/pop stack)
        elem (calc/pop stack)
        new-vector (if (calc/Vector? vector)
                     (calc/wrap elem ;(vector :data))
                     (calc/wrap elem vector))]
    (calc/push stack new-vector)))

(defadv fill 2
  ```
  a s -- a'
  Given a quotation shape `s`, recursively repeats the
  element `a` until it has that shape.
  ```
  (let [shape (calc/pop stack)
        elem (calc/pop stack)]

    (unless (calc/shape? shape)
      (error "Fill error: top argument must be a shape"))

    (let [unwrapped-shape (map |($ :value) (shape :data))
          new-quotation (calc/fill elem unwrapped-shape)]
      (calc/push stack new-quotation))))

(defadv arity 1
  ```
  a -- n
  Pushes the number of stack elements that `a` would consume
  if it were pushed to the stack.
  ```
  (let [elem (calc/pop stack)
        arity (calc/get-arity elem)
        new-elem (calc/make-element arity)]
    (calc/push stack new-elem)))

(defadv shape 1
  ```
  v -- w
  Pushes the shape of the vector `v`.
  ```
  (let [v (calc/pop stack)
        shape (calc/get-shape v)
        new-elem (calc/wrap ;(map calc/make-element shape))]
    (calc/push stack new-elem)))