mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-31 15:43:01 +00:00 
			
		
		
		
	Update core and some examples to use the new
syntax.
This commit is contained in:
		| @@ -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") | ||||||
|  |  | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose