mirror of
https://github.com/janet-lang/janet
synced 2024-11-28 11:09:54 +00:00
Update core and some examples to use the new
syntax.
This commit is contained in:
parent
b0c45fd15e
commit
7dbad20150
@ -4,10 +4,11 @@
|
|||||||
(def tab @{})
|
(def tab @{})
|
||||||
(def solutions @{})
|
(def solutions @{})
|
||||||
(def len (length s))
|
(def len (length s))
|
||||||
(loop [k :range [0 len]]
|
(for k 0 len
|
||||||
(put tab (get s k) k))
|
(put tab s@k k))
|
||||||
(loop [i :range [0 len], j :range [0 len]]
|
(for i 0 len
|
||||||
(def k (get tab (- 0 (get s i) (get s j))))
|
(for j 0 len
|
||||||
|
(def k (get tab (- 0 s@i s@j)))
|
||||||
(when (and k (not= k i) (not= k j) (not= i j))
|
(when (and k (not= k i) (not= k j) (not= i j))
|
||||||
(put solutions {i true j true k true} true)))
|
(put solutions {i true j true k true} true))))
|
||||||
(map keys (keys solution)))
|
(map keys (keys solution)))
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
(def cell-set (frequencies state))
|
(def cell-set (frequencies state))
|
||||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
(def neighbor-set (frequencies (mapcat neighbors state)))
|
||||||
(seq [coord :keys neighbor-set
|
(seq [coord :keys neighbor-set
|
||||||
:let [count (get neighbor-set coord)]
|
:let [count neighbor-set@coord]
|
||||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
||||||
coord))
|
coord))
|
||||||
|
|
||||||
@ -24,7 +24,7 @@
|
|||||||
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
||||||
[state x1 y1 x2 y2]
|
[state x1 y1 x2 y2]
|
||||||
(def cellset @{})
|
(def cellset @{})
|
||||||
(each cell state (put cellset cell true))
|
(each cell state (:= cellset@cell true))
|
||||||
(loop [x :range [x1 (+ 1 x2)]
|
(loop [x :range [x1 (+ 1 x2)]
|
||||||
:after (print)
|
:after (print)
|
||||||
y :range [y1 (+ 1 y2)]]
|
y :range [y1 (+ 1 y2)]]
|
||||||
|
@ -29,14 +29,14 @@
|
|||||||
(array.push modifiers ith))
|
(array.push modifiers ith))
|
||||||
(if (< i len) (recur (+ i 1)))))))
|
(if (< i len) (recur (+ i 1)))))))
|
||||||
(def start (fstart 0))
|
(def start (fstart 0))
|
||||||
(def args (get more start))
|
(def args more@start)
|
||||||
# Add function signature to docstring
|
# Add function signature to docstring
|
||||||
(var index 0)
|
(var index 0)
|
||||||
(def arglen (length args))
|
(def arglen (length args))
|
||||||
(def buf (buffer "(" name))
|
(def buf (buffer "(" name))
|
||||||
(while (< index arglen)
|
(while (< index arglen)
|
||||||
(buffer.push-string buf " ")
|
(buffer.push-string buf " ")
|
||||||
(string.pretty (get args index) 4 buf)
|
(string.pretty args@index 4 buf)
|
||||||
(:= index (+ index 1)))
|
(:= index (+ index 1)))
|
||||||
(array.push modifiers (string buf ")\n\n" docstr))
|
(array.push modifiers (string buf ")\n\n" docstr))
|
||||||
# Build return value
|
# Build return value
|
||||||
@ -95,7 +95,7 @@
|
|||||||
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))
|
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))
|
||||||
(defn keyword? "Check if x is a keyword style symbol."
|
(defn keyword? "Check if x is a keyword style symbol."
|
||||||
[x]
|
[x]
|
||||||
(if (not= (type x) :symbol) nil (= 58 (get x 0))))
|
(if (not= (type x) :symbol) nil (= 58 x@0)))
|
||||||
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
|
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
|
||||||
(defn function? "Check if x is a function (not a cfunction)."
|
(defn function? "Check if x is a function (not a cfunction)."
|
||||||
[x] (= (type x) :function))
|
[x] (= (type x) :function))
|
||||||
@ -183,8 +183,8 @@
|
|||||||
(defn aux [i]
|
(defn aux [i]
|
||||||
(def restlen (- (length pairs) i))
|
(def restlen (- (length pairs) i))
|
||||||
(if (= restlen 0) nil
|
(if (= restlen 0) nil
|
||||||
(if (= restlen 1) (get pairs i)
|
(if (= restlen 1) pairs@i
|
||||||
(tuple 'if (get pairs i)
|
(tuple 'if pairs@i
|
||||||
(get pairs (+ i 1))
|
(get pairs (+ i 1))
|
||||||
(aux (+ i 2))))))
|
(aux (+ i 2))))))
|
||||||
(aux 0))
|
(aux 0))
|
||||||
@ -199,8 +199,8 @@
|
|||||||
(defn aux [i]
|
(defn aux [i]
|
||||||
(def restlen (- (length pairs) i))
|
(def restlen (- (length pairs) i))
|
||||||
(if (= restlen 0) nil
|
(if (= restlen 0) nil
|
||||||
(if (= restlen 1) (get pairs i)
|
(if (= restlen 1) pairs@i
|
||||||
(tuple 'if (tuple = sym (get pairs i))
|
(tuple 'if (tuple = sym pairs@i)
|
||||||
(get pairs (+ i 1))
|
(get pairs (+ i 1))
|
||||||
(aux (+ i 2))))))
|
(aux (+ i 2))))))
|
||||||
(if atm
|
(if atm
|
||||||
@ -234,8 +234,8 @@
|
|||||||
true
|
true
|
||||||
((fn aux [i]
|
((fn aux [i]
|
||||||
(cond
|
(cond
|
||||||
(>= (+ 1 i) len) (get forms i)
|
(>= (+ 1 i) len) forms@i
|
||||||
(tuple 'if (get forms i) (aux (+ 1 i)) false))) 0)))
|
(tuple 'if forms@i (aux (+ 1 i)) false))) 0)))
|
||||||
|
|
||||||
(defmacro or
|
(defmacro or
|
||||||
"Evaluates to the last argument if all preceding elements are false, otherwise
|
"Evaluates to the last argument if all preceding elements are false, otherwise
|
||||||
@ -245,7 +245,7 @@
|
|||||||
(if (= len 0)
|
(if (= len 0)
|
||||||
false
|
false
|
||||||
((fn aux [i]
|
((fn aux [i]
|
||||||
(def fi (get forms i))
|
(def fi forms@i)
|
||||||
(if
|
(if
|
||||||
(>= (+ 1 i) len) fi
|
(>= (+ 1 i) len) fi
|
||||||
(do
|
(do
|
||||||
@ -444,7 +444,7 @@
|
|||||||
(if (zero? len) (error "expected at least 1 binding"))
|
(if (zero? len) (error "expected at least 1 binding"))
|
||||||
(if (odd? len) (error "expected an even number of bindings"))
|
(if (odd? len) (error "expected an even number of bindings"))
|
||||||
(defn aux [i]
|
(defn aux [i]
|
||||||
(def bl (get bindings i))
|
(def bl bindings@i)
|
||||||
(def br (get bindings (+ 1 i)))
|
(def br (get bindings (+ 1 i)))
|
||||||
(if (>= i len)
|
(if (>= i len)
|
||||||
tru
|
tru
|
||||||
@ -478,7 +478,7 @@
|
|||||||
[& functions]
|
[& functions]
|
||||||
(case (length functions)
|
(case (length functions)
|
||||||
0 nil
|
0 nil
|
||||||
1 (get functions 0)
|
1 functions@0
|
||||||
2 (let [[f g] functions] (fn [x] (f (g x))))
|
2 (let [[f g] functions] (fn [x] (f (g x))))
|
||||||
3 (let [[f g h] functions] (fn [x] (f (g (h x)))))
|
3 (let [[f g h] functions] (fn [x] (f (g (h x)))))
|
||||||
4 (let [[f g h i] functions] (fn [x] (f (g (h (i x))))))
|
4 (let [[f g h i] functions] (fn [x] (f (g (h (i x))))))
|
||||||
@ -503,9 +503,9 @@
|
|||||||
[order args]
|
[order args]
|
||||||
(def len (length args))
|
(def len (length args))
|
||||||
(when (pos? len)
|
(when (pos? len)
|
||||||
(var ret (get args 0))
|
(var ret args@0)
|
||||||
(loop [i :range [0 len]]
|
(loop [i :range [0 len]]
|
||||||
(def v (get args i))
|
(def v args@i)
|
||||||
(if (order v ret) (:= ret v)))
|
(if (order v ret) (:= ret v)))
|
||||||
ret))
|
ret))
|
||||||
|
|
||||||
@ -517,7 +517,7 @@
|
|||||||
(defn first
|
(defn first
|
||||||
"Get the first element from an indexed data structure."
|
"Get the first element from an indexed data structure."
|
||||||
[xs]
|
[xs]
|
||||||
(get xs 0))
|
xs@0)
|
||||||
|
|
||||||
(defn last
|
(defn last
|
||||||
"Get the last element from an indexed data structure."
|
"Get the last element from an indexed data structure."
|
||||||
@ -536,17 +536,17 @@
|
|||||||
|
|
||||||
(defn partition
|
(defn partition
|
||||||
[a lo hi by]
|
[a lo hi by]
|
||||||
(def pivot (get a hi))
|
(def pivot a@hi)
|
||||||
(var i lo)
|
(var i lo)
|
||||||
(loop [j :range [lo hi]]
|
(loop [j :range [lo hi]]
|
||||||
(def aj (get a j))
|
(def aj a@j)
|
||||||
(when (by aj pivot)
|
(when (by aj pivot)
|
||||||
(def ai (get a i))
|
(def ai a@i)
|
||||||
(put a i aj)
|
(:= a@i aj)
|
||||||
(put a j ai)
|
(:= a@j ai)
|
||||||
(++ i)))
|
(++ i)))
|
||||||
(put a hi (get a i))
|
(:= a@hi a@i)
|
||||||
(put a i pivot)
|
(:= a@i pivot)
|
||||||
i)
|
i)
|
||||||
|
|
||||||
(defn sort-help
|
(defn sort-help
|
||||||
@ -580,21 +580,21 @@
|
|||||||
[f & inds]
|
[f & inds]
|
||||||
(def ninds (length inds))
|
(def ninds (length inds))
|
||||||
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
||||||
(var limit (length (get inds 0)))
|
(var limit (length inds@0))
|
||||||
(loop [i :range [0 ninds]]
|
(loop [i :range [0 ninds]]
|
||||||
(def l (length (get inds i)))
|
(def l (length inds@i))
|
||||||
(if (< l limit) (:= limit l)))
|
(if (< l limit) (:= limit l)))
|
||||||
(def [i1 i2 i3 i4] inds)
|
(def [i1 i2 i3 i4] inds)
|
||||||
(def res (array.new limit))
|
(def res (array.new limit))
|
||||||
(case ninds
|
(case ninds
|
||||||
1 (loop [i :range [0 limit]] (put res i (f (get i1 i))))
|
1 (loop [i :range [0 limit]] (:= res@i (f i1@i)))
|
||||||
2 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i))))
|
2 (loop [i :range [0 limit]] (:= res@i (f i1@i i2@i)))
|
||||||
3 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i) (get i3 i))))
|
3 (loop [i :range [0 limit]] (:= res@i (f i1@i i2@i i3@i)))
|
||||||
4 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
|
4 (loop [i :range [0 limit]] (:= res@i (f i1@i i2@i i3@i i4@i)))
|
||||||
(loop [i :range [0 limit]]
|
(loop [i :range [0 limit]]
|
||||||
(def args (array.new ninds))
|
(def args (array.new ninds))
|
||||||
(loop [j :range [0 ninds]] (put args j (get (get inds j) i)))
|
(loop [j :range [0 ninds]] (:= args@j inds@j@i))
|
||||||
(put res i (apply f args))))
|
(:= res@i (apply f args))))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(defn mapcat
|
(defn mapcat
|
||||||
@ -646,7 +646,7 @@
|
|||||||
(var i 0)
|
(var i 0)
|
||||||
(var going true)
|
(var going true)
|
||||||
(while (if (< i len) going)
|
(while (if (< i len) going)
|
||||||
(def item (get ind i))
|
(def item ind@i)
|
||||||
(if (pred item) (:= going false) (++ i)))
|
(if (pred item) (:= going false) (++ i)))
|
||||||
(if going nil i))
|
(if going nil i))
|
||||||
|
|
||||||
@ -709,7 +709,7 @@
|
|||||||
[x & forms]
|
[x & forms]
|
||||||
(defn fop [last n]
|
(defn fop [last n]
|
||||||
(def [h t] (if (= :tuple (type n))
|
(def [h t] (if (= :tuple (type n))
|
||||||
[tuple (get n 0) (array.slice n 1)]
|
[tuple n@0 (array.slice n 1)]
|
||||||
[tuple n @[]]))
|
[tuple n @[]]))
|
||||||
(def parts (array.concat @[h last] t))
|
(def parts (array.concat @[h last] t))
|
||||||
(tuple.slice parts 0))
|
(tuple.slice parts 0))
|
||||||
@ -722,7 +722,7 @@
|
|||||||
[x & forms]
|
[x & forms]
|
||||||
(defn fop [last n]
|
(defn fop [last n]
|
||||||
(def [h t] (if (= :tuple (type n))
|
(def [h t] (if (= :tuple (type n))
|
||||||
[tuple (get n 0) (array.slice n 1)]
|
[tuple n@0 (array.slice n 1)]
|
||||||
[tuple n @[]]))
|
[tuple n @[]]))
|
||||||
(def parts (array.concat @[h] t @[last]))
|
(def parts (array.concat @[h] t @[last]))
|
||||||
(tuple.slice parts 0))
|
(tuple.slice parts 0))
|
||||||
@ -750,7 +750,7 @@
|
|||||||
(var n (dec len))
|
(var n (dec len))
|
||||||
(def reversed (array.new len))
|
(def reversed (array.new len))
|
||||||
(while (>= n 0)
|
(while (>= n 0)
|
||||||
(array.push reversed (get t n))
|
(array.push reversed t@n)
|
||||||
(-- n))
|
(-- n))
|
||||||
reversed)
|
reversed)
|
||||||
|
|
||||||
@ -761,7 +761,7 @@ value, one key will be ignored."
|
|||||||
[ds]
|
[ds]
|
||||||
(def ret @{})
|
(def ret @{})
|
||||||
(loop [k :keys ds]
|
(loop [k :keys ds]
|
||||||
(put ret (get ds k) k))
|
(put ret ds@k k))
|
||||||
ret)
|
ret)
|
||||||
|
|
||||||
(defn zipcoll
|
(defn zipcoll
|
||||||
@ -773,7 +773,7 @@ value, one key will be ignored."
|
|||||||
(def lv (length vals))
|
(def lv (length vals))
|
||||||
(def len (if (< lk lv) lk lv))
|
(def len (if (< lk lv) lk lv))
|
||||||
(loop [i :range [0 len]]
|
(loop [i :range [0 len]]
|
||||||
(put res (get keys i) (get vals i)))
|
(put res keys@i vals@i))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
|
|
||||||
@ -781,8 +781,8 @@ value, one key will be ignored."
|
|||||||
"Accepts a key argument and passes its' associated value to a function.
|
"Accepts a key argument and passes its' associated value to a function.
|
||||||
The key then, is associated to the function's return value"
|
The key then, is associated to the function's return value"
|
||||||
[coll a-key a-function & args]
|
[coll a-key a-function & args]
|
||||||
(def old-value (get coll a-key))
|
(def old-value coll@a-key)
|
||||||
(put coll a-key (apply a-function old-value args)))
|
(:= coll@a-key (apply a-function old-value args)))
|
||||||
|
|
||||||
(defn merge-into
|
(defn merge-into
|
||||||
"Merges multiple tables/structs into a table. If a key appears in more than one
|
"Merges multiple tables/structs into a table. If a key appears in more than one
|
||||||
@ -791,7 +791,7 @@ value, one key will be ignored."
|
|||||||
[tab & colls]
|
[tab & colls]
|
||||||
(loop [c :in colls
|
(loop [c :in colls
|
||||||
key :keys c]
|
key :keys c]
|
||||||
(put tab key (get c key)))
|
(:= tab@key c@key))
|
||||||
tab)
|
tab)
|
||||||
|
|
||||||
(defn merge
|
(defn merge
|
||||||
@ -802,7 +802,7 @@ value, one key will be ignored."
|
|||||||
(def container @{})
|
(def container @{})
|
||||||
(loop [c :in colls
|
(loop [c :in colls
|
||||||
key :keys c]
|
key :keys c]
|
||||||
(put container key (get c key)))
|
(:= container@key c@key))
|
||||||
container)
|
container)
|
||||||
|
|
||||||
(defn keys
|
(defn keys
|
||||||
@ -821,7 +821,7 @@ value, one key will be ignored."
|
|||||||
(def arr (array.new (length x)))
|
(def arr (array.new (length x)))
|
||||||
(var k (next x nil))
|
(var k (next x nil))
|
||||||
(while (not= nil k)
|
(while (not= nil k)
|
||||||
(array.push arr (get x k))
|
(array.push arr x@k)
|
||||||
(:= k (next x k)))
|
(:= k (next x k)))
|
||||||
arr)
|
arr)
|
||||||
|
|
||||||
@ -831,7 +831,7 @@ value, one key will be ignored."
|
|||||||
(def arr (array.new (length x)))
|
(def arr (array.new (length x)))
|
||||||
(var k (next x nil))
|
(var k (next x nil))
|
||||||
(while (not= nil k)
|
(while (not= nil k)
|
||||||
(array.push arr (tuple k (get x k)))
|
(array.push arr (tuple k x@k))
|
||||||
(:= k (next x k)))
|
(:= k (next x k)))
|
||||||
arr)
|
arr)
|
||||||
|
|
||||||
@ -841,8 +841,8 @@ value, one key will be ignored."
|
|||||||
(def freqs @{})
|
(def freqs @{})
|
||||||
(loop
|
(loop
|
||||||
[x :in ind]
|
[x :in ind]
|
||||||
(def n (get freqs x))
|
(def n freqs@x)
|
||||||
(put freqs x (if n (+ 1 n) 1)))
|
(:= freqs@x (if n (+ 1 n) 1)))
|
||||||
freqs)
|
freqs)
|
||||||
|
|
||||||
(defn interleave
|
(defn interleave
|
||||||
@ -855,7 +855,7 @@ value, one key will be ignored."
|
|||||||
(def len (apply min (map length cols)))
|
(def len (apply min (map length cols)))
|
||||||
(loop [i :range [0 len]
|
(loop [i :range [0 len]
|
||||||
ci :range [0 ncol]]
|
ci :range [0 ncol]]
|
||||||
(array.push res (get (get cols ci) i))))
|
(array.push res cols@ci@i)))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
###
|
###
|
||||||
@ -909,11 +909,11 @@ value, one key will be ignored."
|
|||||||
(defn doc*
|
(defn doc*
|
||||||
"Get the documentation for a symbol in a given environment."
|
"Get the documentation for a symbol in a given environment."
|
||||||
[env sym]
|
[env sym]
|
||||||
(def x (get env sym))
|
(def x env@sym)
|
||||||
(if (not x)
|
(if (not x)
|
||||||
(print "symbol " sym " not found.")
|
(print "symbol " sym " not found.")
|
||||||
(do
|
(do
|
||||||
(def d (get x :doc))
|
(def d x:doc)
|
||||||
(print "\n\n" (if d (doc-format d) "no documentation found.") "\n\n"))))
|
(print "\n\n" (if d (doc-format d) "no documentation found.") "\n\n"))))
|
||||||
|
|
||||||
(defmacro doc
|
(defmacro doc
|
||||||
@ -935,7 +935,7 @@ value, one key will be ignored."
|
|||||||
(def newt @{})
|
(def newt @{})
|
||||||
(var key (next t nil))
|
(var key (next t nil))
|
||||||
(while (not= nil key)
|
(while (not= nil key)
|
||||||
(put newt (macroexpand-1 key) (on-value (get t key)))
|
(put newt (macroexpand-1 key) (on-value t@key))
|
||||||
(:= key (next t key)))
|
(:= key (next t key)))
|
||||||
newt)
|
newt)
|
||||||
|
|
||||||
@ -949,26 +949,25 @@ value, one key will be ignored."
|
|||||||
|
|
||||||
(defn expanddef [t]
|
(defn expanddef [t]
|
||||||
(def last (get t (- (length t) 1)))
|
(def last (get t (- (length t) 1)))
|
||||||
(def bound (get t 1))
|
(def bound t@1)
|
||||||
(tuple.slice
|
(tuple.slice
|
||||||
(array.concat
|
(array.concat
|
||||||
@[(get t 0) (expand-bindings bound)]
|
@[t@0 (expand-bindings bound)]
|
||||||
(tuple.slice t 2 -2)
|
(tuple.slice t 2 -2)
|
||||||
@[(macroexpand-1 last)])
|
@[(macroexpand-1 last)])))
|
||||||
0))
|
|
||||||
|
|
||||||
(defn expandall [t]
|
(defn expandall [t]
|
||||||
(def args (map macroexpand-1 (tuple.slice t 1)))
|
(def args (map macroexpand-1 (tuple.slice t 1)))
|
||||||
(apply tuple (get t 0) args))
|
(apply tuple t@0 args))
|
||||||
|
|
||||||
(defn expandfn [t]
|
(defn expandfn [t]
|
||||||
(if (symbol? (get t 1))
|
(if (symbol? t@1)
|
||||||
(do
|
(do
|
||||||
(def args (map macroexpand-1 (tuple.slice t 3)))
|
(def args (map macroexpand-1 (tuple.slice t 3)))
|
||||||
(apply tuple 'fn (get t 1) (get t 2) args))
|
(apply tuple 'fn t@1 t@2 args))
|
||||||
(do
|
(do
|
||||||
(def args (map macroexpand-1 (tuple.slice t 2)))
|
(def args (map macroexpand-1 (tuple.slice t 2)))
|
||||||
(apply tuple 'fn (get t 1) args))))
|
(apply tuple 'fn t@1 args))))
|
||||||
|
|
||||||
(def specs
|
(def specs
|
||||||
{':= expanddef
|
{':= expanddef
|
||||||
@ -981,11 +980,11 @@ value, one key will be ignored."
|
|||||||
'while expandall})
|
'while expandall})
|
||||||
|
|
||||||
(defn dotup [t]
|
(defn dotup [t]
|
||||||
(def h (get t 0))
|
(def h t@0)
|
||||||
(def s (get specs h))
|
(def s specs@h)
|
||||||
(def entry (or (get *env* h) {}))
|
(def entry (or *env*@h {}))
|
||||||
(def m (get entry :value))
|
(def m entry:value)
|
||||||
(def m? (get entry :macro))
|
(def m? entry:macro)
|
||||||
(cond
|
(cond
|
||||||
s (s t)
|
s (s t)
|
||||||
m? (apply m (tuple.slice t 1))
|
m? (apply m (tuple.slice t 1))
|
||||||
@ -1042,79 +1041,6 @@ value, one key will be ignored."
|
|||||||
(:= current (macroexpand-1 current)))
|
(:= current (macroexpand-1 current)))
|
||||||
current)
|
current)
|
||||||
|
|
||||||
|
|
||||||
###
|
|
||||||
###
|
|
||||||
### Classes
|
|
||||||
###
|
|
||||||
###
|
|
||||||
|
|
||||||
(defn- parse-signature
|
|
||||||
"Turn a signature into a (method, object) pair."
|
|
||||||
[signature]
|
|
||||||
(when (not (symbol? signature)) (error "expected method signature"))
|
|
||||||
(def parts (string.split ":" signature))
|
|
||||||
(def self (symbol (get parts 0)))
|
|
||||||
(def method (apply symbol (tuple.slice parts 1)))
|
|
||||||
(tuple (tuple 'quote method) self))
|
|
||||||
|
|
||||||
(def class
|
|
||||||
"(class obj)\n\nGets the class of an object."
|
|
||||||
table.getproto)
|
|
||||||
|
|
||||||
(defn instance-of?
|
|
||||||
"Checks if an object is an instance of a class."
|
|
||||||
[class obj]
|
|
||||||
(if obj (or
|
|
||||||
(= class obj)
|
|
||||||
(instance-of? class (table.getproto obj)))))
|
|
||||||
|
|
||||||
(defmacro call
|
|
||||||
"Call a method."
|
|
||||||
[signature & args]
|
|
||||||
(def [method self] (parse-signature signature))
|
|
||||||
(apply tuple (tuple get self method) self args))
|
|
||||||
|
|
||||||
(def $ :macro call)
|
|
||||||
|
|
||||||
(defmacro wrap-call
|
|
||||||
"Wrap a method call in a function."
|
|
||||||
[signature & args]
|
|
||||||
(def [method self] (parse-signature signature))
|
|
||||||
(def $m (gensym))
|
|
||||||
(def $args (gensym))
|
|
||||||
(tuple 'do
|
|
||||||
(tuple 'def $m (tuple get self method))
|
|
||||||
(tuple 'fn (symbol "wrapped-" signature) [tuple '& $args]
|
|
||||||
(tuple apply $m self $args))))
|
|
||||||
|
|
||||||
(defmacro defm
|
|
||||||
"Defines a method for a class."
|
|
||||||
[signature & args]
|
|
||||||
(def [method self] (parse-signature signature))
|
|
||||||
(def i (find-index tuple? args))
|
|
||||||
(def newargs (array.slice args))
|
|
||||||
(put newargs i (tuple.prepend (get newargs i) 'self))
|
|
||||||
(tuple put self method (apply defn signature newargs)))
|
|
||||||
|
|
||||||
(defmacro defnew
|
|
||||||
"Defines the constructor for a class."
|
|
||||||
[class & args]
|
|
||||||
(def newargs (array.slice args))
|
|
||||||
(def i (find-index tuple? args))
|
|
||||||
(array.insert newargs (+ i 1) (tuple 'def 'self (tuple table.setproto @{} class)))
|
|
||||||
(array.push newargs 'self)
|
|
||||||
(tuple put class ''new (apply defn (symbol class :new) newargs)))
|
|
||||||
|
|
||||||
(defmacro defclass
|
|
||||||
"Defines a new prototype class."
|
|
||||||
[name & args]
|
|
||||||
(if (not name) (error "expected a name"))
|
|
||||||
(tuple 'def name
|
|
||||||
(apply tuple table :name (tuple 'quote name) args)))
|
|
||||||
|
|
||||||
(put _env 'parse-signature nil)
|
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### Evaluation and Compilation
|
### Evaluation and Compilation
|
||||||
@ -1326,16 +1252,16 @@ value, one key will be ignored."
|
|||||||
(def cache @{})
|
(def cache @{})
|
||||||
(def loading @{})
|
(def loading @{})
|
||||||
(fn require [path args &]
|
(fn require [path args &]
|
||||||
(when (get loading path)
|
(when loading@path
|
||||||
(error (string "circular dependency: module " path " is loading")))
|
(error (string "circular dependency: module " path " is loading")))
|
||||||
(def {:exit exit-on-error} (or args {}))
|
(def {:exit exit-on-error} (or args {}))
|
||||||
(def check (get cache path))
|
(def check cache@path)
|
||||||
(if check
|
(if check
|
||||||
check
|
check
|
||||||
(do
|
(do
|
||||||
(def newenv (make-env))
|
(def newenv (make-env))
|
||||||
(put cache path newenv)
|
(:= cache@path newenv)
|
||||||
(put loading path true)
|
(:= loading@path true)
|
||||||
(def f (find-mod path))
|
(def f (find-mod path))
|
||||||
(if f
|
(if f
|
||||||
(do
|
(do
|
||||||
@ -1353,7 +1279,7 @@ value, one key will be ignored."
|
|||||||
(if (not n)
|
(if (not n)
|
||||||
(error (string "could not open file for module " path)))
|
(error (string "could not open file for module " path)))
|
||||||
((native n) newenv)))
|
((native n) newenv)))
|
||||||
(put loading path false)
|
(:= loading@path false)
|
||||||
newenv)))))
|
newenv)))))
|
||||||
|
|
||||||
(defn import* [env path & args]
|
(defn import* [env path & args]
|
||||||
@ -1365,8 +1291,8 @@ value, one key will be ignored."
|
|||||||
(def {:meta meta} newenv)
|
(def {:meta meta} newenv)
|
||||||
(def prefix (or (and as (string as ".")) prefix (string path ".")))
|
(def prefix (or (and as (string as ".")) prefix (string path ".")))
|
||||||
(while k
|
(while k
|
||||||
(def v (get newenv k))
|
(def v newenv@k)
|
||||||
(when (not (get v :private))
|
(when (not v:private)
|
||||||
(def newv (table.setproto @{:private true} v))
|
(def newv (table.setproto @{:private true} v))
|
||||||
(put env (symbol prefix k) newv))
|
(put env (symbol prefix k) newv))
|
||||||
(:= k (next newenv k))))
|
(:= k (next newenv k))))
|
||||||
@ -1378,7 +1304,7 @@ value, one key will be ignored."
|
|||||||
use the name of the module as a prefix."
|
use the name of the module as a prefix."
|
||||||
[path & args]
|
[path & args]
|
||||||
(def argm (map (fn [x]
|
(def argm (map (fn [x]
|
||||||
(if (and (symbol? x) (= (get x 0) 58))
|
(if (keyword? x)
|
||||||
x
|
x
|
||||||
(string x)))
|
(string x)))
|
||||||
args))
|
args))
|
||||||
@ -1405,5 +1331,5 @@ value, one key will be ignored."
|
|||||||
(def symbol-set @{})
|
(def symbol-set @{})
|
||||||
(loop [envi :in envs
|
(loop [envi :in envs
|
||||||
k :keys envi]
|
k :keys envi]
|
||||||
(put symbol-set k true))
|
(:= symbol-set@k true))
|
||||||
(sort (keys symbol-set)))
|
(sort (keys symbol-set)))
|
||||||
|
@ -208,8 +208,8 @@
|
|||||||
|
|
||||||
(def @ 1)
|
(def @ 1)
|
||||||
(assert (= @ 1) "@ symbol")
|
(assert (= @ 1) "@ symbol")
|
||||||
(def @@ 2)
|
(def @-- 2)
|
||||||
(assert (= @@ 2) "@@ symbol")
|
(assert (= @-- 2) "@-- symbol")
|
||||||
(def @hey 3)
|
(def @hey 3)
|
||||||
(assert (= @hey 3) "@hey symbol")
|
(assert (= @hey 3) "@hey symbol")
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user