1
0
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:
Calvin Rose 2018-11-29 14:03:45 -05:00
parent b0c45fd15e
commit 7dbad20150
4 changed files with 80 additions and 153 deletions

View File

@ -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)))

View File

@ -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)]]

View File

@ -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)))

View File

@ -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")