mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-01-12 08:30:26 +00:00
Code Issues 1 Releases Wiki Activity

Update require to handle natives better.

Browse Source
This commit is contained in:
Calvin Rose 2018-07-16 22:55:45 -04:00
parent 6b8b21ce77
commit 11292c6bb3
7 changed files with 116 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CMakeLists.txt
View File

@ -23,7 +23,7 @@ project(dst)
# Set Some Variables # Set Some Variables
set(TARGET_NAME ${PROJECT_NAME}) set(TARGET_NAME ${PROJECT_NAME})
set (CMAKE_C_STANDARD 99) set(CMAKE_C_STANDARD 99)
set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wall") set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wall")
# Set configurations # Set configurations

4
Makefile
View File

@ -130,6 +130,10 @@ natives: $(DST_TARGET)
$(MAKE) -C natives/hello $(MAKE) -C natives/hello
$(MAKE) -j 8 -C natives/sqlite3 $(MAKE) -j 8 -C natives/sqlite3
clean-natives:
$(MAKE) -C natives/hello clean
$(MAKE) -C natives/sqlite3 clean
################# #################
##### Other ##### ##### Other #####
################# #################

2
natives/sqlite3/main.c
View File

@ -393,7 +393,7 @@ static const DstReg cfuns[] = {
{NULL, NULL} {NULL, NULL}
}; };
int _dst_init(DstArgs args) { DST_MODULE_ENTRY(DstArgs args) {
DstTable *env = dst_env_arg(args); DstTable *env = dst_env_arg(args);
dst_env_cfuns(env, cfuns); dst_env_cfuns(env, cfuns);
return 0; return 0;

2
src/core/asm.c
View File

@ -676,7 +676,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, Dst source, int flags) {
sizeof(DstInstructionDef), sizeof(DstInstructionDef),
dst_unwrap_symbol(t[0])); dst_unwrap_symbol(t[0]));
if (NULL == idef) if (NULL == idef)
dst_asm_errorv(&a, dst_formatc("unknown instruction %v", instr)); dst_asm_errorv(&a, dst_formatc("unknown instruction %v", t[0]));
op = read_instruction(&a, idef, t); op = read_instruction(&a, idef, t);
} }
def->bytecode[a.bytecode_count++] = op; def->bytecode[a.bytecode_count++] = op;

176
src/core/core.dst
View File

@ -57,14 +57,14 @@
(defn defglobal (defn defglobal
"Dynamically create a global def." "Dynamically create a global def."
[name value] [name value]
(def name* (string name)) (def name* (symbol name))
(put *env* name* @{:value value}) (put *env* name* @{:value value})
nil) nil)
(defn varglobal (defn varglobal
"Dynamically create a global var." "Dynamically create a global var."
[name init] [name init]
(def name* (string name)) (def name* (symbol name))
(put *env* name* @{:ref @[init]}) (put *env* name* @{:ref @[init]})
nil) nil)
@ -435,8 +435,8 @@
(when (pos? len) (when (pos? len)
(var ret (get args 0)) (var ret (get args 0))
(loop [i :range [0 len]] (loop [i :range [0 len]]
(def v (get args i)) (def v (get args i))
(if (order v ret) (:= ret v))) (if (order v ret) (:= ret v)))
ret)) ret))
(defn max [& args] (extreme > args)) (defn max [& args] (extreme > args))
@ -459,12 +459,12 @@
(def pivot (get a hi)) (def pivot (get 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 (get a j))
(when (by aj pivot) (when (by aj pivot)
(def ai (get a i)) (def ai (get a i))
(put a i aj) (put a i aj)
(put a j ai) (put a j ai)
(++ i))) (++ i)))
(put a hi (get a i)) (put a hi (get a i))
(put a i pivot) (put a i pivot)
i) i)
@ -494,7 +494,7 @@
[f init ind] [f init ind]
(var res init) (var res init)
(loop [x :in ind] (loop [x :in ind]
(:= res (f res x))) (:= res (f res x)))
res) res)
(defn map (defn map
@ -505,8 +505,8 @@
(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 (get inds 0)))
(loop [i :range [0 ninds]] (loop [i :range [0 ninds]]
(def l (length (get inds i))) (def l (length (get 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
@ -515,9 +515,9 @@
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]] (put res i (f (get i1 i) (get i2 i) (get 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]] (put res i (f (get i1 i) (get i2 i) (get i3 i) (get 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]] (put args j (get (get inds j) i)))
(put res i (apply1 f args)))) (put res i (apply1 f args))))
res) res)
(defn each (defn each
@ -528,8 +528,8 @@
(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 (get inds 0)))
(loop [i :range [0 ninds]] (loop [i :range [0 ninds]]
(def l (length (get inds i))) (def l (length (get inds i)))
(if (< l limit) (:= limit l))) (if (< l limit) (:= limit l)))
(def [i1 i2 i3 i4] inds) (def [i1 i2 i3 i4] inds)
(case ninds (case ninds
1 (loop [i :range [0 limit]] (f (get i1 i))) 1 (loop [i :range [0 limit]] (f (get i1 i)))
@ -537,9 +537,9 @@
3 (loop [i :range [0 limit]] (f (get i1 i) (get i2 i) (get i3 i))) 3 (loop [i :range [0 limit]] (f (get i1 i) (get i2 i) (get i3 i)))
4 (loop [i :range [0 limit]] (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))) 4 (loop [i :range [0 limit]] (f (get i1 i) (get i2 i) (get i3 i) (get 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]] (array.push args (get (get inds j) i))) (loop [j :range [0 ninds]] (array.push args (get (get inds j) i)))
(apply1 f args)))) (apply1 f args))))
(defn mapcat (defn mapcat
"Map a function over every element in an array or tuple and "Map a function over every element in an array or tuple and
@ -548,7 +548,7 @@
[f ind t] [f ind t]
(def res @[]) (def res @[])
(loop [x :in ind] (loop [x :in ind]
(array.concat res (f x))) (array.concat res (f x)))
(if (= :tuple (type (or t ind))) (if (= :tuple (type (or t ind)))
(apply1 tuple res) (apply1 tuple res)
res)) res))
@ -559,8 +559,8 @@
[pred ind t] [pred ind t]
(def res @[]) (def res @[])
(loop [item :in ind] (loop [item :in ind]
(if (pred item) (if (pred item)
(array.push res item))) (array.push res item)))
(if (= :tuple (type (or t ind))) (if (= :tuple (type (or t ind)))
(apply1 tuple res) (apply1 tuple res)
res)) res))
@ -630,7 +630,7 @@
(fn [& args] (fn [& args]
(def ret @[]) (def ret @[])
(loop [f :in funs] (loop [f :in funs]
(array.push ret (apply1 f args))) (array.push ret (apply1 f args)))
(apply1 tuple ret))) (apply1 tuple ret)))
(defmacro juxt (defmacro juxt
@ -638,7 +638,7 @@
(def parts @['tuple]) (def parts @['tuple])
(def $args (gensym)) (def $args (gensym))
(loop [f :in funs] (loop [f :in funs]
(array.push parts (tuple apply1 f $args))) (array.push parts (tuple apply1 f $args)))
(tuple 'fn (tuple '& $args) (apply1 tuple parts))) (tuple 'fn (tuple '& $args) (apply1 tuple parts)))
(defmacro -> (defmacro ->
@ -715,7 +715,7 @@
(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 (get keys i) (get vals i)))
(if (= :struct t) (if (= :struct t)
(table.to-struct res) (table.to-struct res)
res)) res))
@ -736,7 +736,7 @@
(def container @{}) (def container @{})
(loop [c :in colls (loop [c :in colls
key :keys c] key :keys c]
(put container key (get c key))) (put container key (get c key)))
(if (table? (get colls 0)) container (table.to-struct container))) (if (table? (get colls 0)) container (table.to-struct container)))
(defn keys (defn keys
@ -817,33 +817,33 @@
(if (< len 5) (if (< len 5)
(do (do
(loop [i :range [0 len]] (loop [i :range [0 len]]
(when (not= i 0) (buffer.push-string buf " ")) (when (not= i 0) (buffer.push-string buf " "))
(recur (get y i)))) (recur (get y i))))
(do (do
(buffer.push-string indent " ") (buffer.push-string indent " ")
(loop [i :range [0 len]] (loop [i :range [0 len]]
(when (not= i len) (buffer.push-string buf indent)) (when (not= i len) (buffer.push-string buf indent))
(recur (get y i))) (recur (get y i)))
(buffer.popn indent 2) (buffer.popn indent 2)
(buffer.push-string buf indent)))) (buffer.push-string buf indent))))
(defn pp-dict-nested [y] (defn pp-dict-nested [y]
(buffer.push-string indent " ") (buffer.push-string indent " ")
(loop [[k v] :in (sort (pairs y))] (loop [[k v] :in (sort (pairs y))]
(buffer.push-string buf indent) (buffer.push-string buf indent)
(recur k) (recur k)
(buffer.push-string buf " ") (buffer.push-string buf " ")
(recur v)) (recur v))
(buffer.popn indent 2) (buffer.popn indent 2)
(buffer.push-string buf indent)) (buffer.push-string buf indent))
(defn pp-dict-simple [y] (defn pp-dict-simple [y]
(var i -1) (var i -1)
(loop [[k v] :in (sort (pairs y))] (loop [[k v] :in (sort (pairs y))]
(if (pos? (++ i)) (buffer.push-string buf " ")) (if (pos? (++ i)) (buffer.push-string buf " "))
(recur k) (recur k)
(buffer.push-string buf " ") (buffer.push-string buf " ")
(recur v))) (recur v)))
(defn pp-dict [y] (defn pp-dict [y]
(def complex? (> (length y) 4)) (def complex? (> (length y) 4))
@ -909,16 +909,15 @@
(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 (get t 1) args))
(def specs { (def specs
':= expanddef {':= expanddef
'def expanddef 'def expanddef
'do expandall 'do expandall
'fn expandfn 'fn expandfn
'if expandall 'if expandall
'quote identity 'quote identity
'var expanddef 'var expanddef
'while expandall 'while expandall})
})
(defn dotup [t] (defn dotup [t]
(def h (get t 0)) (def h (get t 0))
@ -931,12 +930,13 @@
m? (apply1 m (tuple.slice t 1)) m? (apply1 m (tuple.slice t 1))
(apply1 tuple (map macroexpand-1 t)))) (apply1 tuple (map macroexpand-1 t))))
(def ret (case (type x) (def ret
:tuple (dotup x) (case (type x)
:array (map macroexpand-1 x) :tuple (dotup x)
:struct (table.to-struct (dotable x macroexpand-1)) :array (map macroexpand-1 x)
:table (dotable x macroexpand-1) :struct (table.to-struct (dotable x macroexpand-1))
x)) :table (dotable x macroexpand-1)
x))
ret) ret)
(defn all? [xs] (defn all? [xs]
@ -1023,7 +1023,7 @@
(chunks buf p) (chunks buf p)
(:= len (length buf)) (:= len (length buf))
(loop [i :range [0 len]] (loop [i :range [0 len]]
(yield (get buf i)))) (yield (get buf i))))
0)) 0))
# Fiber stream of values # Fiber stream of values
@ -1088,16 +1088,14 @@
(when f (when f
(def st (fiber.stack f)) (def st (fiber.stack f))
(loop (loop
[{ [{:function func
:function func
:tail tail :tail tail
:pc pc :pc pc
:c c :c c
:name name :name name
:source source :source source
:line source-line :line source-line
:column source-col :column source-col} :in st]
} :in st]
(file.write stdout " in") (file.write stdout " in")
(when c (file.write stdout " cfunction")) (when c (file.write stdout " cfunction"))
(if name (if name
@ -1106,11 +1104,11 @@
(if source (if source
(do (do
(file.write stdout " [" source "]") (file.write stdout " [" source "]")
(if source-line (if source-line
(file.write (file.write
stdout stdout
" on line " " on line "
(string source-line) (string source-line)
", column " ", column "
(string source-col))))) (string source-col)))))
(if (and (not source-line) pc) (if (and (not source-line) pc)
@ -1132,28 +1130,26 @@
(run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler "eval") (run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler "eval")
returnval) returnval)
(def module.syslibpath (do
(or (os.getenv "DST_PATH") "/usr/local/lib/dst/")) (def syspath (or (os.getenv "DST_PATH") "/usr/local/lib/dst/"))
(defglobal 'module.paths
(def module.paths @["./?.dst"
@["./?.dst" "./?/init.dst"
"./?/init.dst" "./dst_modules/?.dst"
"./dst_modules/?.dst" "./dst_modules/?/init.dst"
"./dst_modules/?/init.dst" (string syspath VERSION "/?.dst")
(string module.syslibpath VERSION "/?.dst") (string syspath VERSION "/?/init.dst")
(string module.syslibpath VERSION "/?/init.dst") (string syspath "/?.dst")
(string module.syslibpath "/?.dst") (string syspath "/?/init.dst")])
(string module.syslibpath "/?/init.dst")]) (defglobal 'module.native-paths
@["./?.so"
(def module.native-paths "./?/??.so"
@["./?.so" "./dst_modules/?.so"
"./?/??.so" "./dst_modules/?/??.so"
"./dst_modules/?.so" (string syspath VERSION "/?.so")
"./dst_modules/?/??.so" (string syspath VERSION "/?/??.so")
(string module.syslibpath VERSION "/?.so") (string syspath "/?.so")
(string module.syslibpath VERSION "/?/??.so") (string syspath "/?/??.so")]))
(string module.syslibpath "/?.so")
(string module.syslibpath "/?/??.so")])
(defn module.find (defn module.find
[path paths] [path paths]
@ -1216,15 +1212,15 @@
(fn [a b c d] (default-error-handler a b c d) (os.exit 1)) (fn [a b c d] (default-error-handler a b c d) (os.exit 1))
default-error-handler) default-error-handler)
path) path)
(file.close f) (file.close f))
(put loading path nil)
newenv)
(do (do
# Try native module # Try native module
(def n (find-native path)) (def n (find-native path))
(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))))))))) ((native n) newenv)))
(put loading path false)
newenv)))))
(defn import* [env path & args] (defn import* [env path & args]
(def targs (apply1 table args)) (def targs (apply1 table args))

22
src/core/gc.c
View File

@ -339,6 +339,24 @@ void dst_gcroot(Dst root) {
dst_vm_root_count = newcount; dst_vm_root_count = newcount;
} }
/* Identity equality for GC purposes */
static int dst_gc_idequals(Dst lhs, Dst rhs) {
if (dst_type(lhs) != dst_type(rhs))
return 0;
switch (dst_type(lhs)) {
case DST_TRUE:
case DST_FALSE:
case DST_NIL:
return 1;
case DST_INTEGER:
return dst_unwrap_integer(lhs) == dst_unwrap_integer(rhs);
case DST_REAL:
return dst_unwrap_real(lhs) == dst_unwrap_real(rhs);
default:
return dst_unwrap_pointer(lhs) == dst_unwrap_pointer(rhs);
}
}
/* Remove a root value from the GC. This allows the gc to potentially reclaim /* Remove a root value from the GC. This allows the gc to potentially reclaim
* a value and all its children. */ * a value and all its children. */
int dst_gcunroot(Dst root) { int dst_gcunroot(Dst root) {
@ -346,7 +364,7 @@ int dst_gcunroot(Dst root) {
Dst *v = dst_vm_roots; Dst *v = dst_vm_roots;
/* Search from top to bottom as access is most likely LIFO */ /* Search from top to bottom as access is most likely LIFO */
for (v = dst_vm_roots; v < vtop; v++) { for (v = dst_vm_roots; v < vtop; v++) {
if (dst_equals(root, *v)) { if (dst_gc_idequals(root, *v)) {
*v = dst_vm_roots[--dst_vm_root_count]; *v = dst_vm_roots[--dst_vm_root_count];
return 1; return 1;
} }
@ -361,7 +379,7 @@ int dst_gcunrootall(Dst root) {
int ret = 0; int ret = 0;
/* Search from top to bottom as access is most likely LIFO */ /* Search from top to bottom as access is most likely LIFO */
for (v = dst_vm_roots; v < vtop; v++) { for (v = dst_vm_roots; v < vtop; v++) {
if (dst_equals(root, *v)) { if (dst_gc_idequals(root, *v)) {
*v = dst_vm_roots[--dst_vm_root_count]; *v = dst_vm_roots[--dst_vm_root_count];
vtop--; vtop--;
ret = 1; ret = 1;

3
src/include/dst/dst.h
View File

@ -1059,6 +1059,9 @@ int dst_lib_parse(DstArgs args);
int dst_lib_asm(DstArgs args); int dst_lib_asm(DstArgs args);
int dst_lib_compile(DstArgs args); int dst_lib_compile(DstArgs args);
/* Helpers for writing modules */
#define DST_MODULE_ENTRY int _dst_init
/***** END SECTION MAIN *****/ /***** END SECTION MAIN *****/
/***** START SECTION MACROS *****/ /***** START SECTION MACROS *****/