~subsetpark/ec

ref: 208a50058aaaa7a7a93cc4bba216ce87bd2ca9cb ec/src/env.janet -rw-r--r-- 3.8 KiB
208a5005 — Zach Smith float parsing and handle bools directly 8 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
(import /src/calc)
(import /src/operations)
(import /src/adverbs)
(import /src/compose)
(import /src/eval)


(def dictionary @{"+" operations/add
                  "-" operations/sub
                  "*" operations/mul
                  "x" operations/mul
                  "%" operations/div
                  "sqrt" operations/sqrt
                  ">" operations/gt
                  "<" operations/lt
                  ">=" operations/gte
                  "<=" operations/lte
                  "=" operations/eq
                  "cmp" operations/cmp
                  "pow" operations/pow
                  "small" operations/small

                  # Combinators
                  "each" adverbs/do-each
                  "dist" adverbs/dist
                  "/" adverbs/dist
                  "apply" adverbs/apply-quotation
                  "i" adverbs/apply-quotation
                  "if" adverbs/if
                  "primrec" adverbs/primrec
                  "linrec" adverbs/linrec
                  # Stack operations
                  "clear" adverbs/clear-stack
                  "c" adverbs/clear-stack
                  "swap" adverbs/swap
                  "dup" adverbs/dup
                  "pop" adverbs/pop
                  "stack" adverbs/push-stack
                  "unstack" adverbs/unstack
                  # Quotation
                  "first" adverbs/quotation-first
                  "quote" adverbs/quote-element
                  "compose" adverbs/compose
                  # Vectors
                  "fill" adverbs/fill
                  "slurp" adverbs/slurp
                  "slurpl" adverbs/slurp-left
                  "slurpr" adverbs/slurp
                  "shape" adverbs/shape
                  "concat" adverbs/concat

                  "def" eval/define

                  "dip" compose/dip
                  "sqr" compose/square
                  "abs" compose/abs
                  "wrap" compose/wrap-1
                  "fac" compose/fac
                  "quote-all" compose/quote-all
                  "wrap-all" compose/wrap-all
                  "swop" compose/swop
                  "length" compose/length})

(defn new-env
  [&opt proto]
  (default proto dictionary)
  (let [s (:new calc/Stack)]
    (put s :env (table/setproto @{} proto))))

(adverbs/defadv map-vector 2
                ```
  v q -- v'
  Insert the contents of quotation `q` in between every element of
  `v`. Wrap the resulting elements in a vector.

  For ordinary operations, this is equivalent to applying them
  directly. For instance, `v (dup 1 +) map` is equivalent to
  `v dup 1 +`.
  ```
                (let [q (calc/pop stack)
                      v (calc/pop stack)
                      substack (new-env (stack :env))]

                  (each elem (calc/data v)
                    (calc/push substack elem)
                    (eval/apply-quotation substack q))

                  (calc/push stack (calc/wrap ;(substack :data)))))

(put dictionary "map" map-vector)

(adverbs/defadv fork 3
                ```
  S a q p -- S a' a'' 
  Apply q to a, and p to a, and push the results on the stack.
  ```
                (let [p (calc/pop stack)
                      q (calc/pop stack)
                      a (calc/pop stack)
                      p-env (new-env (stack :env))
                      q-env (new-env (stack :env))]
                  # Thread 1
                  (calc/push p-env a)
                  (eval/apply-quotation p-env p)
                  # Thread 2
                  (calc/push q-env a)
                  (eval/apply-quotation q-env q)
                  # Main Thread
                  (each elem (q-env :data)
                    (calc/push stack elem))
                  (each elem (p-env :data)
                    (calc/push stack elem))))

(put dictionary "fork" fork)