~subsetpark/ec

ref: c036dd32fafa9d1671676e1e52d4ebdfa236c1bd ec/src/operations.janet -rw-r--r-- 1.9 KiB
c036dd32 — Zach Smith unwrap single tuple 4 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
(use fugue)
(import /src/calc)

(defproto Operation calc/Element
  type {}
  arity {}
  fun-ref {})

(defn- inner-apply
  [op & args]
  (let [x (first args)]
    (if (calc/Vector? x)
      (calc/new-Vector
        (calc/get-shape x)
        (map (partial inner-apply op) ;(map |(@ calc/Vector $ :data) args)))
      (let [f (fun-ref op)
            unwrapped (map |(calc/value $) args)]
        (->> (f ;unwrapped)
             (calc/make-element))))))

(defn apply-operation
  [op & args]
  (let [cmpr (comp length calc/get-shape)
        largest (calc/get-shape (extreme |(> (cmpr $0) (cmpr $1)) args))
        filled (map |(calc/fill $ largest) args)]
    (inner-apply op ;filled)))

(extend-multi calc/push [calc/Stack Operation]
              [self op]
              (calc/check-arity self op)

              (def buf @[])
              (loop [_ :range [0 (arity op)]]
                (array/insert buf 0 (calc/pop self)))

              (->> (apply-operation op ;buf)
                   (calc/make-element)
                   (calc/push self)))

(defmacro defop
  [name arity f &opt doc]
  ~(def ,name (,new-Operation
                 :doc ,doc
                 :type ,(keyword name)
                 :arity ,arity
                 :fun-ref ,f)))

(defop add 2 +)
(defop sub 2 -)
(defop div 2 /)
(defop mul 2 *)
(defop cmp 2 cmp
  ```
  x y -- z
  Push -1 if x < y;
        0 if x = y;
        1 if x > y.
  ```)
(defop pow 2 math/pow)
(defop sqrt 1 math/sqrt)
(defop small 1 |(or (= $ 0) (= $ 1))
  "x -- bool\nPush 1 if x is 0 or 1.")

(defmacro defcmp
  [name arity cmp]
  ~(defop ,name ,arity
     ,cmp
     (string/format ```
                    x y -- bool
                    Comparison predicate.
                    Push 1 if x %s y;
                           else 0.
                    ```
                    ,(string cmp))))

(defcmp lt 2 <)
(defcmp gt 2 >)
(defcmp lte 2 <=)
(defcmp gte 2 >=)
(defcmp eq 2 =)