~subsetpark/ec

ref: c27b383a7158690b1fc7afbca9916942dca67db7 ec/src/adverbs.janet -rw-r--r-- 3.6 KiB
c27b383a — Zach Smith set out-arity for quotations (i think this is valid. whenever you push a quotation to the stack, it always takes one unit) 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
(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 [quotation (calc/pop stack)
        object (calc/pop stack)]

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

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

    (if (calc/Quotation? object)
      (each elem (calc/data object)
        (calc/push stack elem)
        (push-verb))
      (do
        (calc/push stack object)
        (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)
        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
  ```
  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 [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)))

(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)]
    (let [arity (calc/get-arity elem)
          new-elem (calc/make-element arity)]
      (calc/push stack new-elem))))