~subsetpark/ec

ref: 8585fc08ca3344402bbc0099c0782917395cab0c ec/src/calc.janet -rw-r--r-- 3.2 KiB
8585fc08 — Zach Smith Add lockfile 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
(use fugue)

(defproto Stack () data {:default @[]})

(defproto Element ())

(defproto Int Element value {:init? true})
(defproto Float Element value {:init? true})

(defproto Operation Element type {} arity {:default 0} fun-ref {})
(defproto Adverb Element type {} arity {:default 0})

(defproto Vector Element
  shape {:default [] :init? true}
  data {:init? true})

(defgeneric get-shape [_] [])
(defmethod get-shape Vector [self] (self :shape))

(defgeneric fill
  [element shape-to-fill]
  (if (empty? shape-to-fill)
    element
    (let [y (array ;shape-to-fill)
          yi (last y)
          v (:new Vector [yi] (array/new-filled yi element))]
      (fill v y))))

(defmethod fill Vector
  [self shape-to-fill]
  (let [x (array ;(shape self))
        y (array ;shape-to-fill)]
    
    (while (not (empty? x))
      (let [xi (array/pop x)
            yi (array/pop y)]
        (unless (= xi yi)
          (errorf "Shape error: can't fill vector with shape %q to %q"
                  (shape self) shape-to-fill))))
    
    (reduce (fn [acc length]
              (let [new-shape (tuple length ;(shape acc))
                    new-data (array/new-filled length acc)]
                (:new Vector new-shape new-data)))
            self
            (reverse y))))

(defmethod apply-operation Operation
  [op & args]
  (defn inner-apply [op & args]
    (let [x (first args)]
      (if (Vector? x)
        (:new Vector
              (x :shape)
              (map (partial inner-apply op) ;(map |($ :data) args)))
        (let [f (op :fun-ref)
              unwrapped (map |($ :value) args)]
          (f ;unwrapped)))))

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

(defn wrap [& data]
  (let [hd (first data)
        inner-shape (get-shape hd)]
    (each datum data
      (unless (deep= (get-shape datum) inner-shape)
        (errorf "Vector error: can't wrap heterogeneous data. Expected %j, got %j."
                inner-shape
                (get-shape datum))))
    (:new Vector (tuple (length data) ;inner-shape) data)))

(defmethod pop Stack
  [self]
  (-> (self :data) (array/pop)))

(defmethod peek Stack
  [self]
  (-> (self :data) (last)))

(defmethod size Stack
  [self]
  (-> (self :data) (length)))

(defn- check-arity
  [stack arity name]
  (when (> arity (size stack))
    (errorf "Not enough stack; %s has arity %i; stack has size %i"
            (string name)
            arity
            (size stack))))

(defn- make-element
  # TODO: Do we want to do something more sophisticated here?
  [elem]
  (cond (number? elem)
        (:new Float elem)))

(defmulti push [Stack Operation]
  [self op]
  (let [{:arity arity :type op-type} op]
    (check-arity self arity op-type)

    (def buf @[])
    (loop [_ :range [0 arity]]
      (array/push buf (pop self)))
    
    (push self (make-element (apply-operation op ;buf)))))

(defmulti push [Stack _]
  [self item]
  (array/push (self :data) item))

(defmulti push [Stack Adverb]
  [self adv]
  (let [{:arity arity :type adv-type} adv]
    (check-arity self arity adv-type)
    ((adv :fun-ref) self)))

(defn push-all
  [stack args]
  (each arg args
    (push stack arg)))