mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-23 06:50:26 +00:00
Code Issues 1 Releases Wiki Activity

Make array literals require preceding @ character.

Browse Source
This commit is contained in:
Calvin Rose 2018-03-24 12:48:42 -04:00
parent 41d5b5cb90
commit a3ed7327c9
7 changed files with 78 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/primes.dst
View File

@ -3,12 +3,12 @@
(defn primes
"Returns a list of prime numbers less than n."
[n]
(def list [])
(def list @[])
(for [i 2 n]
(var isprime? true)
(def len (length list))
(for [j 0 len]
(def trial (get list j))
(if (zero? (% i trial)) (varset! isprime? false)))
(if (zero? (% i trial)) (:= isprime? false)))
(if isprime? (array-push list i)))
list)

50
src/compiler/boot.dst
View File

@ -16,7 +16,7 @@
(if (if tuple? tuple? array?) i (recur (+ i 1)))))
(def start (fstart 0))
(def fnbody (tuple-prepend (tuple-prepend (tuple-slice more start) name) 'fn))
(def formargs (array-concat ['def name] (array-slice more 0 start) [fnbody]))
(def formargs (array-concat @['def name] (array-slice more 0 start) @[fnbody]))
(apply1 tuple formargs)))
(def defmacro :macro
@ -24,20 +24,20 @@
(do
(def defn* (get (get _env 'defn) :value))
(fn [name & more]
(def args (array-concat [] name :macro more))
(def args (array-concat @[] name :macro more))
(apply1 defn* args))))
(defmacro defmacro-
"Define a private macro that will not be exported."
[name & more]
(apply1 tuple (array-concat
['defmacro name :private] more)))
@['defmacro name :private] more)))
(defmacro defn-
"Define a private function that will not be exported."
[name & more]
(apply1 tuple (array-concat
['defn name :private] more)))
@['defn name :private] more)))
# Basic predicates
(defn even? [x] (== 0 (% x 2)))
@ -199,7 +199,7 @@ If no match is found, returns nil"
(defn iter2array [itr]
(def {:more more :next next} (iter itr))
(def a [])
(def a @[])
(while (more) (array-push a (next)))
a)
@ -235,7 +235,8 @@ If no match is found, returns nil"
(def head (ast-unwrap1 bindings))
(when (odd? (length head)) (error "expected even number of bindings to let"))
(def len (length head))
(var [i accum] [0 ['do]])
(var i 0)
(var accum @['do])
(while (< i len)
(array-push accum (tuple 'def
(get head i)
@ -276,7 +277,7 @@ If no match is found, returns nil"
(defn partial [f & more]
(if (zero? (length more)) f
(fn [& r] (apply1 f (array-concat [] more r)))))
(fn [& r] (apply1 f (array-concat @[] more r)))))
(defmacro for [head & body]
(def head (ast-unwrap1 head))
@ -297,27 +298,27 @@ If no match is found, returns nil"
[& funs]
(def len (length funs))
(fn [& args]
(def ret [])
(def ret @[])
(for [i 0 len]
(array-push ret (apply1 (get funs i) args)))
(apply1 tuple ret)))
(defmacro juxt
[& funs]
(def parts ['tuple])
(def parts @['tuple])
(def $args (gensym))
(for [i 0 (length funs)]
(array-push parts (tuple apply1 (get funs i) $args)))
(tuple 'fn ['& $args] (apply1 tuple parts)))
(tuple 'fn (tuple '& $args) (apply1 tuple parts)))
(defmacro ->
[x & forms]
(defn fop [last nextform]
(def n (ast-unwrap1 nextform))
(def [h t] (if (= :tuple (type n))
[(get n 0) (array-slice n 1)]
[n []]))
(def parts (array-concat [h last] t))
[tuple (get n 0) (array-slice n 1)]
[tuple n @[]]))
(def parts (array-concat @[h last] t))
(apply1 tuple parts))
(reduce fop x forms))
@ -326,9 +327,9 @@ If no match is found, returns nil"
(defn fop [last nextform]
(def n (ast-unwrap1 nextform))
(def [h t] (if (= :tuple (type n))
[(get n 0) (array-slice n 1)]
[n []]))
(def parts (array-concat [h] t [last]))
[tuple (get n 0) (array-slice n 1)]
[tuple n @[]]))
(def parts (array-concat @[h] t @[last]))
(apply1 tuple parts))
(reduce fop x forms))
@ -336,7 +337,7 @@ If no match is found, returns nil"
"Reverses the order of the elements in a given array or tuple and returns a new array."
[t]
(var n (dec (length t)))
(var reversed [])
(var reversed @[])
(while (>= n 0)
(array-push reversed (get t n))
(-- n))
@ -386,7 +387,7 @@ If no match is found, returns nil"
(tuple
'when
(and (get head 1) (if (get head 2) (get head 3) true))
(apply1 tuple (array-concat ['do] (ast-unwrap1 body))))))
(apply1 tuple (array-concat @['do] (ast-unwrap1 body))))))
(defn comp
"Takes multiple functions and returns a function that is the composition
@ -400,7 +401,7 @@ If no match is found, returns nil"
4 (let [[f g h i] functions] (fn [x] (f (g (h (i x))))))
(let [[f g h i j] functions]
(apply comp (fn [x] (f (g (h (i (j x))))))
(array-slice functions 5 -1)))))
(tuple-slice functions 5 -1)))))
(defn zipcoll
"Creates an table or tuple from two arrays/tuples. Result is table if no
@ -419,7 +420,7 @@ third argument is given"
"Accepts a key argument and passes its associated value to a function.
The key, then is associated to that value"
[coll a-key a-function & args]
(def old-value (get coll a-key) )
(def old-value (get coll a-key))
(put coll a-key (apply a-function old-value args)))
(defn merge
@ -470,7 +471,7 @@ third argument is given"
buf)
(def printers :private {
:array (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]" true))
:array (fn [pp seen buf x] (pp-seq pp seen buf x "@[" "]" true))
:tuple (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
:table (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}" true))
:struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
@ -499,7 +500,7 @@ third argument is given"
(defn doarray [a]
(def len (length a))
(def newa [])
(def newa @[])
(for [i 0 len]
(array-push newa (macroexpand1 (get a i))))
newa)
@ -577,11 +578,10 @@ third argument is given"
(:= current (macroexpand1 current)))
current)
(defn make-env [parent safe]
(defn make-env [parent]
(def parent (if parent parent _env))
(def newenv (setproto @{} parent))
(if (not safe)
(put newenv '_env @{:value newenv}))
(put newenv '_env @{:value newenv :private true})
newenv)
(def run-context

4
src/compiler/compile.c
View File

@ -830,6 +830,10 @@ recur:
x = dst_resume(f, dst_tuple_length(tup) - 1, tup + 1);
dst_gcunlock(lock);
if (f->status == DST_FIBER_ERROR || f->status == DST_FIBER_DEBUG) {
dst_puts(dst_unwrap_string(x));
printf("\n");
dst_puts(dst_unwrap_string(headval));
printf("\n");
dstc_cerror(c, ast, "error in macro expansion");
}
/* Tail recur on the value */

10
src/mainclient/init.dst
View File

@ -1,5 +1,5 @@
(var should-repl false)
(var no-file true)
(var *should-repl* false)
(var *no-file* true)
# Flag handlers
(def handlers {
@ -11,7 +11,7 @@
(print " -r Enter the repl after running all scripts")
(exit 0))
"v" (fn [] (print VERSION) (exit 0))
"r" (fn [] (:= should-repl true))
"r" (fn [] (:= *should-repl* true))
})
(defn dohandler [n]
@ -25,9 +25,9 @@
(if (= "-" (string-slice arg 0 1))
(dohandler (string-slice arg 1 2))
(do
(:= no-file false)
(:= *no-file* false)
(import arg))))
(when (or should-repl no-file)
(when (or *should-repl* *no-file*)
(print (string "Dst " VERSION " Copyright (C) 2017-2018 Calvin Rose"))
(repl getline))

24
src/parser/parse.c
View File

@ -157,6 +157,7 @@ struct DstParseState {
#define PFLAG_CONTAINER 1
#define PFLAG_BUFFER 2
#define PFLAG_SQRBRACKETS 4
static void pushstate(DstParser *p, Consumer consumer, int flags) {
DstParseState s;
@ -336,7 +337,9 @@ static int comment(DstParser *p, DstParseState *state, uint8_t c) {
static int root(DstParser *p, DstParseState *state, uint8_t c);
static int dotuple(DstParser *p, DstParseState *state, uint8_t c) {
if (c == ')') {
if (state->flags & PFLAG_SQRBRACKETS
? c == ']'
: c == ')') {
int32_t i;
Dst *ret = dst_tuple_begin(state->argn);
for (i = state->argn - 1; i >= 0; i--) {
@ -349,7 +352,9 @@ static int dotuple(DstParser *p, DstParseState *state, uint8_t c) {
}
static int doarray(DstParser *p, DstParseState *state, uint8_t c) {
if (c == ']') {
if (state->flags & PFLAG_SQRBRACKETS
? c == ']'
: c == ')') {
int32_t i;
DstArray *array = dst_array(state->argn);
for (i = state->argn - 1; i >= 0; i--) {
@ -405,12 +410,21 @@ static int dotable(DstParser *p, DstParseState *state, uint8_t c) {
static int ampersand(DstParser *p, DstParseState *state, uint8_t c) {
(void) state;
dst_v_pop(p->states);
if (c == '{') {
switch (c) {
case '{':
pushstate(p, dotable, PFLAG_CONTAINER);
return 1;
} else if (c == '"') {
case '"':
pushstate(p, stringchar, PFLAG_BUFFER);
return 1;
case '[':
pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
return 1;
case '(':
pushstate(p, doarray, PFLAG_CONTAINER);
return 1;
default:
break;
}
pushstate(p, tokenchar, 0);
dst_v_push(p->buf, '@'); /* Push the leading ampersand that was dropped */
@ -448,7 +462,7 @@ static int root(DstParser *p, DstParseState *state, uint8_t c) {
pushstate(p, dotuple, PFLAG_CONTAINER);
return 1;
case '[':
pushstate(p, doarray, PFLAG_CONTAINER);
pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
return 1;
case '{':
pushstate(p, dostruct, PFLAG_CONTAINER);

39
test/suite0.dst
View File

@ -178,11 +178,11 @@
(def vargf (fn [more] (apply + more)))
(assert (= 0 (vargf [])) "var arg no arguments")
(assert (= 1 (vargf [1])) "var arg no packed arguments")
(assert (= 3 (vargf [1 2])) "var arg tuple size 1")
(assert (= 10 (vargf [1 2 3 4])) "var arg tuple size 3")
(assert (= 110 (vargf [1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple")
(assert (= 0 (vargf @[])) "var arg no arguments")
(assert (= 1 (vargf @[1])) "var arg no packed arguments")
(assert (= 3 (vargf @[1 2])) "var arg tuple size 1")
(assert (= 10 (vargf @[1 2 3 4])) "var arg tuple size 2, 2 normal args")
(assert (= 110 (vargf @[1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple")
# Higher order functions
@ -205,7 +205,7 @@
(assert (= (string "🐼" 🦊 🐮) "🐼:fox:cow") "emojis 🙉 :)")
(assert (not= 🦊 :🦊) "utf8 strings are not symbols and vice versa")
# Symbols with @ symbol
# Symbols with @ character
(def @ 1)
(assert (= @ 1) "@ symbol")
@ -218,7 +218,7 @@
# Imperative merge sort merge
(def merge (fn [xs ys]
(def ret [])
(def ret @[])
(def xlen (length xs))
(def ylen (length ys))
(var i 0)
@ -242,10 +242,10 @@
(:= j (+ j 1)))
ret))
(assert (apply <= (merge [1 3 5] [2 4 6])) "merge sort merge 1")
(assert (apply <= (merge [1 2 3] [4 5 6])) "merge sort merge 2")
(assert (apply <= (merge [1 3 5] [2 4 6 6 6 9])) "merge sort merge 3")
(assert (apply <= (merge '(1 3 5) [2 4 6 6 6 9])) "merge sort merge 4")
(assert (apply <= (merge @[1 3 5] @[2 4 6])) "merge sort merge 1")
(assert (apply <= (merge @[1 2 3] @[4 5 6])) "merge sort merge 2")
(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
# Gensym tests
@ -262,8 +262,8 @@
# Let
(assert (= (let [a 1 b 2] (+ a b)) 3), "simple let")
(assert (= (let [[a b] [1 2]] (+ a b)) 3), "destructured let")
(assert (= (let [[a [c d] b] [1 (tuple 4 3) 2]] (+ a b c d)) 10), "double destructured let")
(assert (= (let [[a b] @[1 2]] (+ a b)) 3), "destructured let")
(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10), "double destructured let")
# Macros
@ -275,14 +275,15 @@
(do
(var i 0)
(when true
(:= i (+ i 1))
(:= i (+ i 1))
(:= i (+ i 1))
(:= i (+ i 1))
(:= i (+ i 1))
(:= i (+ i 1)))
(++ i)
(++ i)
(++ i)
(++ i)
(++ i)
(++ i))
(assert (= i 6) "when macro"))
# report
(print "\n" num-tests-passed " of " num-tests-run " tests passed\n")

6
test/suite1.dst
View File

@ -33,10 +33,10 @@
(print " \e[31m✘\e[0m " e)
x))))
(if (not= 400.0 (sqrt 160000)) (error "sqrt(160000)=400"))
(if (not= (real 400) (sqrt 160000)) (error "sqrt(160000)=400"))
(assert (= 400.0 (sqrt 160000)) "sqrt(160000)=400")
(assert (= (real 400) (sqrt 160000)) "sqrt(160000)=400")
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het [1 2 3 4 5]})
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
(assert (= (get test-struct 'def) 1) "struct get")
(assert (= (get test-struct 'bork) 2) "struct get")
(assert (= (get test-struct 'sam) 3) "struct get")