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

Change convention for naming modules and functions.

Browse Source
This commit is contained in:
Calvin Rose 2018-05-08 19:40:28 -04:00
parent 8fd8b1126b
commit f47323c915
25 changed files with 272 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@ -65,7 +65,8 @@ $
## Docmentation
API documentation and design documents will be added to the `doc` folder as they are written.
As of March 2018, specifications are sparse because dst is evolving.
As of March 2018, specifications are sparse because dst is evolving. Check the doc folder for
an introduction of Dst as well as an overview of the bytecode format.
## Compiling and Running

4
examples/assembly.dst
View File

@ -1,12 +1,12 @@
# Example of dst bytecode assembly
# Fibonacci sequence, implemented with naive recursion.
(def fibasm (asm '{
(def fibasm (asm/asm '{
arity 1
bytecode [
(ldi 1 0x2) # $1 = 2
(lt 1 0 1) # $1 = $0 < $1
(jmpif 1 :done) # if ($1) goto :done
(jmpif 1 :done) # if ($1) goto :done
(lds 1) # $1 = self
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0), push argument for next function call

2
examples/iterators.dst
View File

@ -46,7 +46,7 @@
(defn iter2array [itr]
(def {:more more :next next} (iter itr))
(def a @[])
(while (more) (array-push a (next)))
(while (more) (array.push a (next)))
a)
(defn map [f itr]

13
examples/lazyseqs.dst
View File

@ -18,7 +18,7 @@ body once, and then memoizes the result."
$state
(tuple 'do
(tuple ':= $loaded true)
(tuple ':= $state (tuple-prepend forms 'do)))))))
(tuple ':= $state (tuple.prepend forms 'do)))))))
# Use tuples instead of structs to save memory
(def HEAD :private 0)
@ -129,14 +129,3 @@ body once, and then memoizes the result."
(when-let [n (node)]
(:= node (get n 1))
(get n 0)))})
# Now we can use the non-functional filter from boot.dst
# to write a filter version that returns a lazy sequence
# Be careful when creating lazy sequences from mutable
# data structures as their values are references to this
# data structures. Same is true for iterators
(defn filter2 [pred coll] (iter2lazy (filter pred coll)))
# be careful with the filter function. First element in (filter pos? arr) is nil
# last element is false

10
examples/maxtriangle.dst
View File

@ -2,11 +2,11 @@
# of the triangle to the leaves of the triangle.
(defn myfold [xs ys]
(def xs1 (tuple-prepend xs 0))
(def xs2 (tuple-append xs 0))
(def m1 (map + xs1 ys))
(def m2 (map + xs2 ys))
(map max m1 m2))
(let [xs1 (tuple.prepend xs 0)
xs2 (tuple.append xs 0)
m1 (map + xs1 ys)
m2 (map + xs2 ys)]
(map max m1 m2)))
(defn maxpath [t]
(extreme > (reduce myfold () t)))

2
examples/primes.dst
View File

@ -10,5 +10,5 @@
(for [j 0 len]
(def trial (get list j))
(if (zero? (% i trial)) (:= isprime? false)))
(if isprime? (array-push list i)))
(if isprime? (array.push list i)))
list)

12
natives/sqlite3/main.c
View File

@ -38,7 +38,7 @@ static int gcsqlite(void *p, size_t s) {
}
static const DstAbstractType sql_conn_type = {
":sqlite3.conn",
":sqlite3.connection",
gcsqlite,
NULL,
};
@ -77,15 +77,15 @@ static int sql_close(DstArgs args) {
static int sql_execute_callback(void *rowsp, int n, char **vals, char **colnames) {
int i;
DstArray *rows = (DstArray *)rowsp;
DstTable *row = dst_table(n);
DstKV *row = dst_struct_begin(n);
for (i = 0; i < n; i++) {
dst_table_put(row, dst_cstringv(colnames[i]), dst_cstringv(vals[i]));
dst_struct_put(row, dst_cstringv(colnames[i]), dst_cstringv(vals[i]));
}
dst_array_push(rows, dst_wrap_table(row));
dst_array_push(rows, dst_wrap_struct(dst_struct_end(row)));
return 0;
}
static int sql_execute(DstArgs args) {
static int sql_sql(DstArgs args) {
int status;
char *errmsg = "connection closed";
const uint8_t *str;
@ -121,7 +121,7 @@ static int sql_rowid(DstArgs args) {}
static const DstReg cfuns[] = {
{"open", sql_open},
{"close", sql_close},
{"execute", sql_execute},
{"sql", sql_sql},
/*{"tables", sql_tables},*/
/*{"changes", sql_changes},*/
/*{"timeout", sql_timeout},*/

4
src/assembler/asm.c
View File

@ -908,8 +908,8 @@ int dst_disasm_cfun(DstArgs args) {
}
static const DstReg cfuns[] = {
{"asm", dst_asm_cfun},
{"disasm", dst_disasm_cfun},
{"asm/asm", dst_asm_cfun},
{"asm/disasm", dst_disasm_cfun},
{NULL, NULL}
};

230
src/compiler/boot.dst
View File

@ -12,19 +12,19 @@
_env)
(def defn :macro
"Define a function"
"Define a function. Equivalent to (def name (fn name [args] ...))."
(fn [name & more]
(def len (length more))
(def fstart (fn recur [i]
(def ith (ast-unwrap1 (get more i)))
(def ith (ast.unwrap1 (get more i)))
(def t (type ith))
(def tuple? (= t :tuple))
(def array? (= t :array))
(if (if tuple? tuple? array?) i
(if (< i len) (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 fnbody (tuple.prepend (tuple.prepend (tuple.slice more start) name) 'fn))
(def formargs (array.concat @['def name] (array.slice more 0 start) @[fnbody]))
(apply1 tuple formargs)))
(def defmacro :macro
@ -32,39 +32,39 @@
(do
(def defn* (get (get _env 'defn) :value))
(fn [name & more]
(apply1 defn* (array-concat
(apply1 defn* (array.concat
@[name :macro] more)))))
(defmacro defmacro-
"Define a private macro that will not be exported."
[name & more]
(apply1 tuple (array-concat
(apply1 tuple (array.concat
@['defmacro name :private] more)))
(defmacro defdo
"Define a value inside of a do form."
[name & more]
(apply1 tuple (array-concat
(apply1 tuple (array.concat
@['def name]
(apply1 tuple (array-concat @['do] more)))))
(apply1 tuple (array.concat @['do] more)))))
(defmacro defdo-
"Define a private value inside of a do form."
[name & more]
(apply1 tuple (array-concat
(apply1 tuple (array.concat
@['def name :private]
(apply1 tuple (array-concat @['do] more)))))
(apply1 tuple (array.concat @['do] more)))))
(defmacro defn-
"Define a private function that will not be exported."
[name & more]
(apply1 tuple (array-concat
(apply1 tuple (array.concat
@['defn name :private] more)))
(defmacro def-
"Define a private value that will not be exported."
[name & more]
(apply1 tuple (array-concat
(apply1 tuple (array.concat
@['def name :private] more)))
# Basic predicates
@ -132,12 +132,12 @@ Expands to (def sym (if (= nil sym) val sym))"
(defmacro when
"Evaluates the body when the condition is true. Otherwise returns nil."
[condition & body]
(tuple 'if condition (tuple-prepend body 'do)))
(tuple 'if condition (tuple.prepend body 'do)))
(defmacro when-not
"Shorthand for (when (not ... "
[condition & body]
(tuple 'if condition nil (tuple-prepend body 'do)))
(tuple 'if condition nil (tuple.prepend body 'do)))
(defmacro cond
"Evaluates conditions sequentially until the first true condition
@ -174,14 +174,14 @@ tuple and will be spliced into the function call. For example, (apply + 1 2 @[3
evaluates to 10."
[f & args]
(def last (- (length args) 1))
(apply1 f (array-concat (array-slice args 0 -2) (get args last))))
(apply1 f (array.concat (array.slice args 0 -2) (get args last))))
(defmacro switch
"Select the body that equals the dispatch value. When pairs
has an odd number of arguments, the last is the default expression.
If no match is found, returns nil"
[dispatch & pairs]
(def atm (atomic? (ast-unwrap1 dispatch)))
(def atm (atomic? (ast.unwrap1 dispatch)))
(def sym (if atm dispatch (gensym)))
(defn aux [i]
(def restlen (- (length pairs) i))
@ -201,30 +201,30 @@ If no match is found, returns nil"
assigned as if with def, and the body of the let form returns the last
value."
[bindings & body]
(def head (ast-unwrap1 bindings))
(def head (ast.unwrap1 bindings))
(if (odd? (length head)) (error "expected even number of bindings to let"))
(def len (length head))
(var i 0)
(var accum @['do])
(while (< i len)
(array-push accum (tuple 'def
(array.push accum (tuple 'def
(get head i)
(get head (+ 1 i))))
(+= i 2))
(array-concat accum body)
(array.concat accum body)
(apply1 tuple accum))
(defmacro for
"An imperative for loop over an integer range. Use with caution and discretion."
[head & body]
(def [sym start end _inc] (ast-unwrap1 head))
(def [sym start end _inc] (ast.unwrap1 head))
(def inc (if _inc _inc 1))
(def endsym (gensym))
(tuple 'do
(tuple 'var sym start)
(tuple 'def endsym end)
(tuple 'while (tuple < sym endsym)
(tuple-prepend body 'do)
(tuple.prepend body 'do)
(tuple ':= sym (tuple + sym inc)))))
(defmacro and
@ -247,7 +247,7 @@ evaluates to true."
(if
(>= (inc i) len) fi
(do
(if (atomic? (ast-unwrap1 fi))
(if (atomic? (ast.unwrap1 fi))
(tuple 'if fi fi (aux (inc i)))
(do
(def $fi (gensym))
@ -264,7 +264,7 @@ evaluates to true."
all the forms with let and evaluates the first expression else
evaluates the second"
[bindings tru fal]
(def bindings (ast-unwrap1 bindings))
(def bindings (ast.unwrap1 bindings))
(def len (length bindings))
(if (zero? len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
@ -274,7 +274,7 @@ evaluates to true."
(if (>= i len)
tru
(do
(def atm (atomic? (ast-unwrap1 bl)))
(def atm (atomic? (ast.unwrap1 bl)))
(def sym (if atm bl (gensym)))
(if atm
# Simple binding
@ -295,7 +295,7 @@ evaluates to true."
"Takes the first one or two forms in vector and if true binds
all the forms with let and evaluates the body"
[bindings & body]
(tuple 'if-let bindings (tuple-prepend body 'do)))
(tuple 'if-let bindings (tuple.prepend body 'do)))
(defn comp
"Takes multiple functions and returns a function that is the composition
@ -309,7 +309,7 @@ evaluates to true."
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))))))
(tuple-slice functions 5 -1)))))
(tuple.slice functions 5 -1)))))
(defn identity
"A function that returns its first argument."
@ -404,14 +404,14 @@ the same type as the input sequence."
(if (< l limit) (:= limit l)))
(def [i1 i2 i3 i4] inds)
(switch ninds
1 (for [i 0 limit] (array-push res (f (get i1 i))))
2 (for [i 0 limit] (array-push res (f (get i1 i) (get i2 i))))
3 (for [i 0 limit] (array-push res (f (get i1 i) (get i2 i) (get i3 i))))
4 (for [i 0 limit] (array-push res (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
1 (for [i 0 limit] (array.push res (f (get i1 i))))
2 (for [i 0 limit] (array.push res (f (get i1 i) (get i2 i))))
3 (for [i 0 limit] (array.push res (f (get i1 i) (get i2 i) (get i3 i))))
4 (for [i 0 limit] (array.push res (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
(for [i 0 limit]
(def args @[])
(for [j 0 ninds] (array-push args (get (get inds j) i)))
(array-push res (apply1 f args))))
(for [j 0 ninds] (array.push args (get (get inds j) i)))
(array.push res (apply1 f args))))
res)
(defn each
@ -432,7 +432,7 @@ return a new indexed type."
4 (for [i 0 limit] (f (get i1 i) (get i2 i) (get i3 i) (get i4 i)))
(for [i 0 limit]
(def args @[])
(for [j 0 ninds] (array-push args (get (get inds j) i)))
(for [j 0 ninds] (array.push args (get (get inds j) i)))
(apply1 f args))))
(defn mapcat
@ -442,7 +442,7 @@ type as the input sequence."
[f ind t]
(def res @[])
(for [i 0 (length ind)]
(array-concat res (f (get ind i))))
(array.concat res (f (get ind i))))
(if (= :tuple (type (or t ind)))
(apply1 tuple res)
res))
@ -455,7 +455,7 @@ which (pred element) is truthy. Returns the same type as the input sequence."
(for [i 0 (length ind)]
(def item (get ind i))
(if (pred item)
(array-push res item)))
(array.push res item)))
(if (= :tuple (type (or t ind)))
(apply1 tuple res)
res))
@ -485,8 +485,8 @@ the same type as the input."
[pred ind t]
(def i (find-index pred ind))
(if (= :tuple (type (or t ind)))
(tuple-slice ind 0 i)
(array-slice ind 0 i)))
(tuple.slice ind 0 i)
(array.slice ind 0 i)))
(defn take-while
"Same as (take-until (complement pred) ind t)."
@ -499,8 +499,8 @@ the predicate, and abort on first failure."
[pred ind t]
(def i (find-index pred ind))
(if (= :tuple (type (or t ind)))
(tuple-slice ind i -1)
(array-slice ind i -1)))
(tuple.slice ind i -1)
(array.slice ind i -1)))
(defn drop-while
"Same as (drop-until (complement pred) ind t)."
@ -513,7 +513,7 @@ the predicate, and abort on first failure."
(fn [& args]
(def ret @[])
(for [i 0 len]
(array-push ret (apply1 (get funs i) args)))
(array.push ret (apply1 (get funs i) args)))
(apply1 tuple ret)))
(defmacro juxt
@ -521,7 +521,7 @@ the predicate, and abort on first failure."
(def parts @['tuple])
(def $args (gensym))
(for [i 0 (length funs)]
(array-push parts (tuple apply1 (get funs i) $args)))
(array.push parts (tuple apply1 (get funs i) $args)))
(tuple 'fn (tuple '& $args) (apply1 tuple parts)))
(defmacro ->
@ -530,11 +530,11 @@ in form, and inserts the modified firsts form into the second form
in the same manner, and so on. Useful for expressing pipelines of data."
[x & forms]
(defn fop [last nextform]
(def n (ast-unwrap1 nextform))
(def n (ast.unwrap1 nextform))
(def [h t] (if (= :tuple (type n))
[tuple (get n 0) (array-slice n 1)]
[tuple (get n 0) (array.slice n 1)]
[tuple n @[]]))
(def parts (array-concat @[h last] t))
(def parts (array.concat @[h last] t))
(apply1 tuple parts))
(reduce fop x forms))
@ -544,11 +544,11 @@ in form, and inserts the modified firsts form into the second form
in the same manner, and so on. Useful for expressing pipelines of data."
[x & forms]
(defn fop [last nextform]
(def n (ast-unwrap1 nextform))
(def n (ast.unwrap1 nextform))
(def [h t] (if (= :tuple (type n))
[tuple (get n 0) (array-slice n 1)]
[tuple (get n 0) (array.slice n 1)]
[tuple n @[]]))
(def parts (array-concat @[h] t @[last]))
(def parts (array.concat @[h] t @[last]))
(apply1 tuple parts))
(reduce fop x forms))
@ -556,7 +556,7 @@ in the same manner, and so on. Useful for expressing pipelines of data."
"Partial function application."
[f & more]
(if (zero? (length more)) f
(fn [& r] (apply1 f (array-concat @[] more r)))))
(fn [& r] (apply1 f (array.concat @[] more r)))))
(defn every? [pred seq]
(var res true)
@ -569,27 +569,27 @@ in the same manner, and so on. Useful for expressing pipelines of data."
(do (:= res false) (:= i len))))
res)
(defn reverse-array
(defn array.reverse
"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 @[])
(while (>= n 0)
(array-push reversed (get t n))
(array.push reversed (get t n))
(-- n))
reversed)
(defn reverse-tuple
(defn tuple.reverse
"Reverses the order of the elements given an array or tuple and returns a tuple"
[t]
(apply1 tuple (reverse-array t)))
(apply1 tuple (array.reverse t)))
(defn reverse
"Reverses order of elements in a given array or tuple"
[t]
(switch (type t)
:tuple (reverse-tuple t)
:array (reverse-array t)))
((switch (type t)
:tuple tuple.reverse
:array array.reverse) t))
(defn zipcoll
"Creates an table or tuple from two arrays/tuples. If a third argument of
@ -602,7 +602,7 @@ in the same manner, and so on. Useful for expressing pipelines of data."
(for [i 0 len]
(put res (get keys i) (get vals i)))
(if (= :struct t)
(table-to-struct res)
(table.to-struct res)
res))
(defn update
@ -625,7 +625,7 @@ in the same manner, and so on. Useful for expressing pipelines of data."
(while (not= nil key)
(put container key (get c key))
(:= key (next c key))))
(if (table? (get colls 0)) container (table-to-struct container)))
(if (table? (get colls 0)) container (table.to-struct container)))
(defn keys
"Get the keys of an associative data structure."
@ -633,7 +633,7 @@ in the same manner, and so on. Useful for expressing pipelines of data."
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array-push arr k)
(array.push arr k)
(:= k (next x k)))
arr)
@ -643,7 +643,7 @@ in the same manner, and so on. Useful for expressing pipelines of data."
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array-push arr (get x k))
(array.push arr (get x k))
(:= k (next x k)))
arr)
@ -653,7 +653,7 @@ in the same manner, and so on. Useful for expressing pipelines of data."
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array-push arr (tuple k (get x k)))
(array.push arr (tuple k (get x k)))
(:= k (next x k)))
arr)
@ -681,49 +681,49 @@ to call on any table. Does not print table prototype information."
(def id (get seen y))
(if (and checkcycle id)
(do
(buffer-push-string buf "<cycle ")
(buffer-push-string buf (string id))
(buffer-push-string buf ">"))
(buffer.push-string buf "<cycle ")
(buffer.push-string buf (string id))
(buffer.push-string buf ">"))
(do
(put seen y (++ nextid))
(buffer-push-string buf start)
(buffer.push-string buf start)
(dispatch y)
(buffer-push-string buf end))))
(buffer.push-string buf end))))
(defn pp-seq [y]
(def len (length y))
(if (< len 5)
(do
(for [i 0 len]
(when (not= i 0) (buffer-push-string buf " "))
(when (not= i 0) (buffer.push-string buf " "))
(recur (get y i))))
(do
(buffer-push-string indent " ")
(buffer.push-string indent " ")
(for [i 0 len]
(when (not= i len) (buffer-push-string buf indent))
(when (not= i len) (buffer.push-string buf indent))
(recur (get y i)))
(buffer-popn indent 2)
(buffer-push-string buf indent))))
(buffer.popn indent 2)
(buffer.push-string buf indent))))
(defn pp-dict-nested [y]
(buffer-push-string indent " ")
(buffer.push-string indent " ")
(def ps (sort (pairs y)))
(for [i 0 (length ps)]
(def [k v] (get ps i))
(buffer-push-string buf indent)
(buffer.push-string buf indent)
(recur k)
(buffer-push-string buf " ")
(buffer.push-string buf " ")
(recur v))
(buffer-popn indent 2)
(buffer-push-string buf indent))
(buffer.popn indent 2)
(buffer.push-string buf indent))
(defn pp-dict-simple [y]
(def ps (sort (pairs y)))
(for [i 0 (length ps)]
(def [k v] (get ps i))
(if (pos? i) (buffer-push-string buf " "))
(if (pos? i) (buffer.push-string buf " "))
(recur k)
(buffer-push-string buf " ")
(buffer.push-string buf " ")
(recur v)))
(defn pp-dict [y]
@ -741,12 +741,12 @@ to call on any table. Does not print table prototype information."
(def p (get printers (type y)))
(if p
(p y)
(buffer-push-string buf (describe y)))))
(buffer.push-string buf (describe y)))))
(recur x)
(buffer-push-string buf "\n")
(buffer.push-string buf "\n")
(file-write stdout buf))
(file.write stdout buf))
###
###
@ -762,7 +762,7 @@ to call on any table. Does not print table prototype information."
(def len (length a))
(def newa @[])
(for [i 0 len]
(array-push newa (macroexpand1 (get a i))))
(array.push newa (macroexpand1 (get a i))))
newa)
(defn dotable [t]
@ -776,14 +776,14 @@ to call on any table. Does not print table prototype information."
(defn expandlast [t]
(def len (length t))
(def last (get t (- len 1)))
(tuple-append (tuple-slice t 0 -2) (macroexpand1 last)))
(tuple.append (tuple.slice t 0 -2) (macroexpand1 last)))
(defn expandall [t]
(def args (doarray (tuple-slice t 1)))
(def args (doarray (tuple.slice t 1)))
(apply tuple (get t 0) args))
(defn expandfn [t]
(def args (doarray (tuple-slice t 2)))
(def args (doarray (tuple.slice t 2)))
(apply tuple 'fn (get t 1) args))
(def specs {
@ -806,7 +806,7 @@ to call on any table. Does not print table prototype information."
(def m? (get entry :macro))
(cond
s (s t)
m? (apply1 m (tuple-slice t 1))
m? (apply1 m (tuple.slice t 1))
(apply1 tuple (doarray t))))
(defn doarray* [a]
@ -815,13 +815,13 @@ to call on any table. Does not print table prototype information."
(defn dotable* [t]
(def res (dotable t))
(if (= (table-to-struct res) (table-to-struct t)) t res))
(if (= (table.to-struct res) (table.to-struct t)) t res))
(def ux (ast-unwrap1 x))
(def ux (ast.unwrap1 x))
(switch (type ux)
:tuple (dotup ux)
:array (doarray* ux)
:struct (table-to-struct (dotable ux))
:struct (table.to-struct (dotable ux))
:table (dotable* ux)
ux))
@ -846,7 +846,7 @@ to call on any table. Does not print table prototype information."
(defn make-env [parent]
(def parent (if parent parent _env))
(def newenv (setproto @{} parent))
(def newenv (table.setproto @{} parent))
(put newenv '_env @{:value newenv :private true})
newenv)
@ -868,14 +868,14 @@ onvalue."
(var going true)
# The parser object
(def p (parser 1))
(def p (parser.make 1))
# Fiber stream of characters
(def chars (coro
(def buf @"")
(var len 1)
(while (< 0 len)
(buffer-clear buf)
(buffer.clear buf)
(chunks buf p)
(:= len (length buf))
(for [i 0 len]
@ -885,14 +885,14 @@ onvalue."
# Fiber stream of values
(def vals (coro
(while going
(switch (parser-status p)
:full (yield (parser-produce p))
:error (onerr "parse" (parser-error p))
(switch (fiber-status chars)
:new (parser-byte p (resume chars))
:pending (parser-byte p (resume chars))
(switch (parser.status p)
:full (yield (parser.produce p))
:error (onerr "parse" (parser.error p))
(switch (fiber.status chars)
:new (parser.byte p (resume chars))
:pending (parser.byte p (resume chars))
(:= going false))))
(when (not= :root (parser-status p))
(when (not= :root (parser.status p))
(onerr "parse" "unexpected end of source"))))
# Evaluate 1 source form
@ -907,7 +907,7 @@ onvalue."
(onerr "compile" (get res :error))))))
(def res (resume f))
(if good
(if (= (fiber-status f) :error)
(if (= (fiber.status f) :error)
(onerr "runtime" res f)
(if going (onvalue res)))))
@ -921,10 +921,10 @@ onvalue."
(defn default-error-handler
[t x f]
(file-write stdout (string t " error: "))
(file.write stdout (string t " error: "))
(pp x)
(when f
(def st (fiber-stack f))
(def st (fiber.stack f))
(def len (length st))
(for [i 0 len]
(def {
@ -934,13 +934,13 @@ onvalue."
:c c
:name name
} (get st i))
(file-write stdout " in")
(when c (file-write stdout " cfunction"))
(when name (file-write stdout (string " " name)))
(when func (file-write stdout (string " " func)))
(when pc (file-write stdout (string " (pc=" pc ")")))
(when tail (file-write stdout " (tailcall)"))
(file-write stdout "\n"))))
(file.write stdout " in")
(when c (file.write stdout " cfunction"))
(when name (file.write stdout (string " " name)))
(when func (file.write stdout (string " " func)))
(when pc (file.write stdout (string " (pc=" pc ")")))
(when tail (file.write stdout " (tailcall)"))
(file.write stdout "\n"))))
(defn eval
"Evaluates a string in the current environment. If more control over the
@ -951,7 +951,7 @@ environment is needed, use run-context."
(def ret state)
(:= state nil)
(if ret
(buffer-push-string buf ret)))
(buffer.push-string buf ret)))
(var returnval nil)
(run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler)
returnval)
@ -965,17 +965,17 @@ environment is needed, use run-context."
(def check (get cache path))
(if check check (do
(if (or
(= ".so" (string-slice path -3 -1))
(= ".dll" (string-slice path -4 -1)))
(= ".so" (string.slice path -3 -1))
(= ".dll" (string.slice path -4 -1)))
((native path))
(do
(def newenv (make-env))
(put cache path newenv)
(put loading path true)
(def f (file-open path))
(defn chunks [buf] (file-read f 1024 buf))
(def f (file.open path))
(defn chunks [buf] (file.read f 1024 buf))
(run-context newenv chunks identity default-error-handler)
(file-close f)
(file.close f)
(put loading path nil)
newenv)))))))
@ -1000,7 +1000,7 @@ environment is needed, use run-context."
get a chunk of source code. Should return nil for end of file."
(def newenv (make-env))
(default getchunk (fn [buf]
(file-read stdin :line buf)))
(file.read stdin :line buf)))
(default onvalue (fn [x]
(put newenv '_ @{:value x})
(pp x)))

6
src/compiler/stl.c
View File

@ -45,12 +45,10 @@ static const DstReg cfuns[] = {
{"scan-real", dst_core_scanreal},
{"tuple", dst_core_tuple},
{"struct", dst_core_struct},
{"fiber", dst_core_fiber},
{"buffer", dst_core_buffer},
{"gensym", dst_core_gensym},
{"get", dst_core_get},
{"rawget", dst_core_rawget},
{"getproto", dst_core_getproto},
{"setproto", dst_core_setproto},
{"put", dst_core_put},
{"length", dst_core_length},
{"gccollect", dst_core_gccollect},
@ -59,7 +57,7 @@ static const DstReg cfuns[] = {
{"type", dst_core_type},
{"next", dst_core_next},
{"hash", dst_core_hash},
{"string-slice", dst_core_string_slice},
{"string.slice", dst_core_string_slice},
{NULL, NULL}
};

14
src/core/array.c
View File

@ -219,13 +219,13 @@ static int cfun_concat(DstArgs args) {
}
static const DstReg cfuns[] = {
{"array-pop", cfun_pop},
{"array-peek", cfun_peek},
{"array-push", cfun_push},
{"array-setcount", cfun_setcount},
{"array-ensure", cfun_ensure},
{"array-slice", cfun_slice},
{"array-concat", cfun_concat},
{"array.pop", cfun_pop},
{"array.peek", cfun_peek},
{"array.push", cfun_push},
{"array.setcount", cfun_setcount},
{"array.ensure", cfun_ensure},
{"array.slice", cfun_slice},
{"array.concat", cfun_concat},
{NULL, NULL}
};

12
src/core/buffer.c
View File

@ -258,12 +258,12 @@ static int cfun_slice(DstArgs args) {
}
static const DstReg cfuns[] = {
{"buffer-push-byte", cfun_u8},
{"buffer-push-integer", cfun_int},
{"buffer-push-string", cfun_chars},
{"buffer-popn", cfun_popn},
{"buffer-clear", cfun_clear},
{"buffer-slice", cfun_slice},
{"buffer.push-byte", cfun_u8},
{"buffer.push-integer", cfun_int},
{"buffer.push-string", cfun_chars},
{"buffer.popn", cfun_popn},
{"buffer.clear", cfun_clear},
{"buffer.slice", cfun_slice},
{NULL, NULL}
};

34
src/core/corelib.c
View File

@ -202,6 +202,14 @@ int dst_core_struct(DstArgs args) {
return dst_return(args, dst_wrap_struct(dst_struct_end(st)));
}
int dst_core_fiber(DstArgs args) {
DstFiber *fiber;
dst_fixarity(args, 1);
dst_check(args, 0, DST_FUNCTION);
fiber = dst_fiber(dst_unwrap_function(args.v[0]), 64);
return dst_return(args, dst_wrap_fiber(fiber));
}
int dst_core_gensym(DstArgs args) {
dst_maxarity(args, 1);
if (args.n == 0) {
@ -230,32 +238,6 @@ int dst_core_get(DstArgs args) {
return dst_return(args, ds);
}
int dst_core_rawget(DstArgs args) {
dst_fixarity(args, 2);
dst_check(args, 0, DST_TABLE);
return dst_return(args, dst_table_rawget(dst_unwrap_table(args.v[0]), args.v[1]));
}
int dst_core_getproto(DstArgs args) {
DstTable *t;
dst_fixarity(args, 1);
dst_check(args, 0, DST_TABLE);
t = dst_unwrap_table(args.v[0]);
return dst_return(args, t->proto
? dst_wrap_table(t->proto)
: dst_wrap_nil());
}
int dst_core_setproto(DstArgs args) {
dst_fixarity(args, 2);
dst_check(args, 0, DST_TABLE);
dst_checkmany(args, 1, DST_TFLAG_TABLE | DST_TFLAG_NIL);
dst_unwrap_table(args.v[0])->proto = dst_checktype(args.v[1], DST_TABLE)
? dst_unwrap_table(args.v[1])
: NULL;
return dst_return(args, args.v[0]);
}
int dst_core_put(DstArgs args) {
Dst ds, key, value;
DstArgs subargs = args;

13
src/core/fiber.c
View File

@ -257,14 +257,6 @@ void dst_fiber_popframe(DstFiber *fiber) {
/* CFuns */
static int cfun_fiber(DstArgs args) {
DstFiber *fiber;
dst_fixarity(args, 1);
dst_check(args, 0, DST_FUNCTION);
fiber = dst_fiber(dst_unwrap_function(args.v[0]), 64);
return dst_return(args, dst_wrap_fiber(fiber));
}
static int cfun_status(DstArgs args) {
const char *status = "";
dst_fixarity(args, 1);
@ -346,9 +338,8 @@ static int cfun_stack(DstArgs args) {
}
static const DstReg cfuns[] = {
{"fiber", cfun_fiber},
{"fiber-status", cfun_status},
{"fiber-stack", cfun_stack},
{"fiber.status", cfun_status},
{"fiber.stack", cfun_stack},
{NULL, NULL}
};

12
src/core/io.c
View File

@ -298,12 +298,12 @@ static int dst_io_fseek(DstArgs args) {
#endif
static const DstReg cfuns[] = {
{"file-open", dst_io_fopen},
{"file-close", dst_io_fclose},
{"file-read", dst_io_fread},
{"file-write", dst_io_fwrite},
{"file-flush", dst_io_fflush},
{"file-seek", dst_io_fseek},
{"file.open", dst_io_fopen},
{"file.close", dst_io_fclose},
{"file.read", dst_io_fread},
{"file.write", dst_io_fwrite},
{"file.flush", dst_io_fflush},
{"file.seek", dst_io_fseek},
{NULL, NULL}
};

8
src/core/os.c
View File

@ -86,10 +86,10 @@ static int os_exit(DstArgs args) {
}
static const DstReg cfuns[] = {
{"os-execute", os_execute},
{"os-exit", os_exit},
{"os-getenv", os_getenv},
{"os-setenv", os_setenv},
{"os.execute", os_execute},
{"os.exit", os_exit},
{"os.getenv", os_getenv},
{"os.setenv", os_setenv},
{NULL, NULL}
};

5
src/core/string.c
View File

@ -103,7 +103,7 @@ const uint8_t *dst_cstring(const char *str) {
}
/* Temporary buffer size */
#define BUFSIZE 36
#define BUFSIZE 64
static int32_t real_to_string_impl(uint8_t *buf, double x) {
/* Use 16 decimal places to ignore one ulp errors for now */
@ -175,7 +175,8 @@ static int32_t string_description_impl(uint8_t *buf, const char *title, void *po
pbuf.p = pointer;
*c++ = '<';
for (i = 0; title[i] && i < 12; ++i)
/* Maximum of 32 bytes for abstract type name */
for (i = 0; title[i] && i < 32; ++i)
*c++ = ((uint8_t *)title) [i];
*c++ = ' ';
*c++ = '0';

31
src/core/table.c
View File

@ -235,6 +235,26 @@ void dst_table_merge_struct(DstTable *table, const DstKV *other) {
dst_table_mergekv(table, other, dst_struct_capacity(other));
}
static int cfun_getproto(DstArgs args) {
DstTable *t;
dst_fixarity(args, 1);
dst_check(args, 0, DST_TABLE);
t = dst_unwrap_table(args.v[0]);
return dst_return(args, t->proto
? dst_wrap_table(t->proto)
: dst_wrap_nil());
}
static int cfun_setproto(DstArgs args) {
dst_fixarity(args, 2);
dst_check(args, 0, DST_TABLE);
dst_checkmany(args, 1, DST_TFLAG_TABLE | DST_TFLAG_NIL);
dst_unwrap_table(args.v[0])->proto = dst_checktype(args.v[1], DST_TABLE)
? dst_unwrap_table(args.v[1])
: NULL;
return dst_return(args, args.v[0]);
}
static int cfun_tostruct(DstArgs args) {
DstTable *t;
dst_fixarity(args, 1);
@ -242,8 +262,17 @@ static int cfun_tostruct(DstArgs args) {
return dst_return(args, dst_wrap_struct(dst_table_to_struct(t)));
}
static int cfun_rawget(DstArgs args) {
dst_fixarity(args, 2);
dst_check(args, 0, DST_TABLE);
return dst_return(args, dst_table_rawget(dst_unwrap_table(args.v[0]), args.v[1]));
}
static const DstReg cfuns[] = {
{"table-to-struct", cfun_tostruct},
{"table.to-struct", cfun_tostruct},
{"table.getproto", cfun_getproto},
{"table.setproto", cfun_setproto},
{"table.rawget", cfun_rawget},
{NULL, NULL}
};

6
src/core/tuple.c
View File

@ -152,8 +152,8 @@ static int cfun_append(DstArgs args) {
/* Load the tuple module */
int dst_lib_tuple(DstArgs args) {
DstTable *env = dst_env_arg(args);
dst_env_def(env, "tuple-slice", dst_wrap_cfunction(cfun_slice));
dst_env_def(env, "tuple-append", dst_wrap_cfunction(cfun_append));
dst_env_def(env, "tuple-prepend", dst_wrap_cfunction(cfun_prepend));
dst_env_def(env, "tuple.slice", dst_wrap_cfunction(cfun_slice));
dst_env_def(env, "tuple.append", dst_wrap_cfunction(cfun_append));
dst_env_def(env, "tuple.prepend", dst_wrap_cfunction(cfun_prepend));
return 0;
}

4
src/include/dst/dstcorelib.h
View File

@ -92,13 +92,11 @@ int dst_core_tuple(DstArgs args);
int dst_core_array(DstArgs args);
int dst_core_table(DstArgs args);
int dst_core_struct(DstArgs args);
int dst_core_fiber(DstArgs args);
int dst_core_buffer(DstArgs args);
int dst_core_gensym(DstArgs args);
int dst_core_length(DstArgs args);
int dst_core_get(DstArgs args);
int dst_core_rawget(DstArgs args);
int dst_core_getproto(DstArgs args);
int dst_core_setproto(DstArgs args);
int dst_core_put(DstArgs args);
int dst_core_type(DstArgs args);
int dst_core_next(DstArgs args);

90
src/mainclient/init.dst
View File

@ -1,51 +1,51 @@
(do
(var *should-repl* :private false)
(var *no-file* :private true)
(var *raw-stdin* :private false)
(var *should-repl* :private false)
(var *no-file* :private true)
(var *raw-stdin* :private false)
# Flag handlers
(def handlers :private {
"h" (fn []
(print "usage: " (get args 0) " [options] scripts...")
(print "Options are:")
(print " -h Show this help")
(print " -v Print the version string")
(print " -s Use raw stdin instead of getline like functionality")
(print " -e Execute a string of dst")
(print " -r Enter the repl after running all scripts")
(os-exit 0)
1)
"v" (fn [] (print VERSION) (os-exit 0) 1)
"s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
"r" (fn [] (:= *should-repl* true) 1)
"e" (fn [i]
(:= *no-file* false)
(eval (get args (+ i 1)))
2)
})
# Flag handlers
(def handlers :private {
"h" (fn []
(print "usage: " (get args 0) " [options] scripts...")
(print "Options are:")
(print " -h Show this help")
(print " -v Print the version string")
(print " -s Use raw stdin instead of getline like functionality")
(print " -e Execute a string of dst")
(print " -r Enter the repl after running all scripts")
(os.exit 0)
1)
"v" (fn [] (print VERSION) (os.exit 0) 1)
"s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
"r" (fn [] (:= *should-repl* true) 1)
"e" (fn [i]
(:= *no-file* false)
(eval (get args (+ i 1)))
2)
})
(defn- dohandler [n i]
(def h (get handlers n))
(if h (h i) (print "unknown flag -" n)))
(defn- dohandler [n i]
(def h (get handlers n))
(if h (h i) (print "unknown flag -" n)))
# Process arguments
(var i 1)
(def lenargs (length args))
(while (< i lenargs)
(def arg (get args i))
(if (= "-" (string-slice arg 0 1))
(+= i (dohandler (string-slice arg 1 2) i))
(do
(:= *no-file* false)
(import arg)
(++ i))))
# Process arguments
(var i 1)
(def lenargs (length args))
(while (< i lenargs)
(def arg (get args i))
(if (= "-" (string.slice arg 0 1))
(+= i (dohandler (string.slice arg 1 2) i))
(do
(:= *no-file* false)
(import arg)
(++ i))))
(when (or *should-repl* *no-file*)
(if *raw-stdin*
(repl nil identity)
(do
(print (string "Dst " VERSION " Copyright (C) 2017-2018 Calvin Rose"))
(repl (fn [buf p]
(def prompt (string (parser-state p) "> "))
(getline prompt buf)))))))
(when (or *should-repl* *no-file*)
(if *raw-stdin*
(repl nil identity)
(do
(print (string "Dst " VERSION " Copyright (C) 2017-2018 Calvin Rose"))
(repl (fn [buf p]
(def prompt (string (parser.state p) "> "))
(getline prompt buf)))))))

24
src/parser/parse.c
View File

@ -769,18 +769,18 @@ static int cfun_node(DstArgs args) {
}
static const DstReg cfuns[] = {
{"parser", cfun_parser},
{"parser-produce", cfun_produce},
{"parser-consume", cfun_consume},
{"parser-byte", cfun_byte},
{"parser-error", cfun_error},
{"parser-status", cfun_status},
{"parser-flush", cfun_flush},
{"parser-state", cfun_state},
{"ast-unwrap", cfun_unwrap},
{"ast-unwrap1", cfun_unwrap1},
{"ast-wrap", cfun_wrap},
{"ast-node", cfun_node},
{"parser.make", cfun_parser},
{"parser.produce", cfun_produce},
{"parser.consume", cfun_consume},
{"parser.byte", cfun_byte},
{"parser.error", cfun_error},
{"parser.status", cfun_status},
{"parser.flush", cfun_flush},
{"parser.state", cfun_state},
{"ast.unwrap", cfun_unwrap},
{"ast.unwrap1", cfun_unwrap1},
{"ast.wrap", cfun_wrap},
{"ast.node", cfun_node},
{NULL, NULL}
};

2
test/helper.dst
View File

@ -19,4 +19,4 @@
(defn end-suite []
(print "\nTest suite " suite-num " finished.")
(print num-tests-passed " of " num-tests-run " tests passed.\n")
(if (not= num-tests-passed num-tests-run) (os-exit 1)))
(if (not= num-tests-passed num-tests-run) (os.exit 1)))

12
test/suite0.dst
View File

@ -151,7 +151,7 @@
(def afiber-result (resume afiber "world!"))
(assert (= afiber-result "hello, world!") "fiber error result")
(assert (= (fiber-status afiber) :error) "fiber error status")
(assert (= (fiber.status afiber) :error) "fiber error status")
# yield tests
@ -160,7 +160,7 @@
(assert (= 1 (resume t)) "initial transfer to new fiber")
(assert (= 2 (resume t)) "second transfer to fiber")
(assert (= 3 (resume t)) "return from fiber")
(assert (= (fiber-status t) :dead) "finished fiber is dead")
(assert (= (fiber.status t) :dead) "finished fiber is dead")
# Var arg tests
@ -216,17 +216,17 @@
(def xi (get xs i))
(def yj (get ys j))
(if (< xi yj)
(do (array-push ret xi) (:= i (+ i 1)))
(do (array-push ret yj) (:= j (+ j 1)))))
(do (array.push ret xi) (:= i (+ i 1)))
(do (array.push ret yj) (:= j (+ j 1)))))
# Push rest of xs
(while (< i xlen)
(def xi (get xs i))
(array-push ret xi)
(array.push ret xi)
(:= i (+ i 1)))
# Push rest of ys
(while (< j ylen)
(def yj (get ys j))
(array-push ret yj)
(array.push ret yj)
(:= j (+ j 1)))
ret))

2
test/suite1.dst
View File

@ -60,7 +60,7 @@
:childprop 456
})
(setproto childtab roottab)
(table.setproto childtab roottab)
(assert (= 123 (get roottab :parentprop)), "table get 1")
(assert (= 123 (get childtab :parentprop)), "table get proto")