~subsetpark/ec

ref: 5f2065e7cc6bb4fd362d3861bfd2a5cdc32f128f ec/src/adverbs.janet -rw-r--r-- 4.1 KiB
5f2065e7 — Zach Smith Add if 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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
(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))))

(defn- do-apply
  [stack quotation]
  (if (calc/Quotation*? quotation)
      (do (calc/check-arity stack quotation)
        (each elem (calc/data quotation)
          (calc/push stack elem)))
      (calc/push stack quotation)))

(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)]
    (do-apply 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)))

(defadv if 3
  ```
  qt qf p -- x
  If `p` = 0, applies the quotation `qf`.
     else applies `qt`.
 ```
  (let [p (calc/pop stack)
        qf (calc/pop stack)
        qt (calc/pop stack)]
    (case (p :value)
      0 (do-apply stack qf)
      (do-apply stack qt))))