~subsetpark/ec

ref: bd73813f66ec440d293ebe5a8f1e3237343c5ab0 ec/src/adverbs.janet -rw-r--r-- 3.8 KiB
bd73813f — Zach Smith Introduce vectors and .[] syntax 11 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`, 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
  Returns 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
  Returns 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)))