mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-01-23 13:46:52 +00:00
Code Issues 1 Releases Wiki Activity

Merge pull request #6 from Gavlooth/master

Browse Source 
Some thoughts
This commit is contained in:
Calvin Rose 2018-03-24 11:53:57 -04:00 committed by GitHub
commit 3c57980ef1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 50 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
examples/lazyseqs.dst
View File

@ -109,15 +109,14 @@ body once, and then memoizes the result."
#Iterators is a conscept that looks a lot like lazy seq #Iterators is a conscept that looks a lot like lazy seq
#The following functions turn iterators to lazy seq and vice versa #The following functions turn iterators to lazy seq and vice versa
(defn- iter-self
[next]
(delay (tuple (next) (iter-self next))))
(defn iter2lazy (defn iter2lazy
"Create a lazy sequence froma an iterator" "Create a lazy sequence from an iterator"
[iter] [iter]
(def {:more more :next next} iter) (def {:more more :next next} iter)
(iter-self next)) (if (more)
(delay (tuple (next) (iter2lazy iter)))
empty-seq))
(defn lazy2iter (defn lazy2iter
"turn a lazy-seq to an iterator" "turn a lazy-seq to an iterator"
@ -138,8 +137,7 @@ body once, and then memoizes the result."
#data structures as their values are references to this #data structures as their values are references to this
#data structures. Same is true for iterators #data structures. Same is true for iterators
(defn filter2 [pred coll] (defn filter2 [pred coll] (iter2lazy (filter pred coll)))
(tail (iter2lazy (filter pred coll))))
(def arr [0 -1 -2 33 -3 0 302 -3 2 8 54 3 -2 0]) (def arr [0 -1 -2 33 -3 0 302 -3 2 8 54 3 -2 0])

64
src/compiler/boot.dst
View File

@ -1,13 +1,13 @@
# Bootstrap the dst environment # Bootstrap the dst environment
# Copyright 2018 (C) Calvin Rose # Copyright 2018 (C) Calvin Rose
(var *env* (var *env*
"The current environment." "The current environment."
_env) _env)
(def defn :macro (def defn :macro
"Define a function" "Define a function"
(fn [name & more] (fn [name & more]
(def fstart (fn recur [i] (def fstart (fn recur [i]
(def ith (ast-unwrap1 (get more i))) (def ith (ast-unwrap1 (get more i)))
(def t (type ith)) (def t (type ith))
@ -23,7 +23,7 @@
"Define a macro." "Define a macro."
(do (do
(def defn* (get (get _env 'defn) :value)) (def defn* (get (get _env 'defn) :value))
(fn [name & more] (fn [name & more]
(def args (array-concat [] name :macro more)) (def args (array-concat [] name :macro more))
(apply1 defn* args)))) (apply1 defn* args))))
@ -86,7 +86,7 @@
(defmacro when (defmacro when
"Evaluates the body when the condition is true. Otherwise returns nil." "Evaluates the body when the condition is true. Otherwise returns nil."
[cond & body] [cond & body]
(tuple 'if cond (tuple-prepend body 'do))) (tuple 'if cond (tuple-prepend body 'do)))
(defmacro cond (defmacro cond
@ -140,21 +140,21 @@ If no match is found, returns nil"
(tuple 'def sym dispatch) (tuple 'def sym dispatch)
(aux 0))) (aux 0)))
(defmacro and [& forms] (defmacro and [& forms]
(def len (length forms)) (def len (length forms))
(if (= len 0) true ((fn aux [i] (if (= len 0) true ((fn aux [i]
(cond (cond
(>= (inc i) len) (get forms i) (>= (inc i) len) (get forms i)
(tuple 'if (get forms i) (aux (inc i)) false))) 0))) (tuple 'if (get forms i) (aux (inc i)) false))) 0)))
(defmacro or [& forms] (defmacro or [& forms]
(def len (length forms)) (def len (length forms))
(if (= len 0) false ((fn aux [i] (if (= len 0) false ((fn aux [i]
(cond (cond
(>= (inc i) len) (get forms i) (>= (inc i) len) (get forms i)
(tuple 'if (get forms i) true (aux (inc i))))) 0))) (tuple 'if (get forms i) true (aux (inc i))))) 0)))
(defn identity (defn identity
"A function that returns its first argument." "A function that returns its first argument."
[x] x) [x] x)
@ -167,7 +167,7 @@ If no match is found, returns nil"
:next (fn [] :next (fn []
(def ret (get x i)) (def ret (get x i))
(:= i (+ i 1)) (:= i (+ i 1))
ret) ret)
}) })
(def iters { (def iters {
:array array-iter :array array-iter
@ -184,20 +184,20 @@ If no match is found, returns nil"
:next (fn [] :next (fn []
(def ret i) (def ret i)
(:= i (+ i 1)) (:= i (+ i 1))
ret) ret)
}) })
(defn range [top] (range2 0 top)) (defn range [top] (range2 0 top))
(defn doiter [itr] (defn doiter [itr]
(def {:more more :next next} (iter itr)) (def {:more more :next next} (iter itr))
(while (more) (next))) (while (more) (next)))
(defn foreach [itr f] (defn foreach [itr f]
(def {:more more :next next} (iter itr)) (def {:more more :next next} (iter itr))
(while (more) (f (next)))) (while (more) (f (next))))
(defn iter2array [itr] (defn iter2array [itr]
(def {:more more :next next} (iter itr)) (def {:more more :next next} (iter itr))
(def a []) (def a [])
(while (more) (array-push a (next))) (while (more) (array-push a (next)))
@ -237,7 +237,7 @@ If no match is found, returns nil"
(def len (length head)) (def len (length head))
(var [i accum] [0 ['do]]) (var [i accum] [0 ['do]])
(while (< i len) (while (< i len)
(array-push accum (tuple 'def (array-push accum (tuple 'def
(get head i) (get head i)
(get head (+ 1 i)))) (get head (+ 1 i))))
(:= i (+ i 2))) (:= i (+ i 2)))
@ -379,7 +379,7 @@ If no match is found, returns nil"
(defmacro when-let (defmacro when-let
"Takes the first one or two forms in vector and if true binds "Takes the first one or two forms in vector and if true binds
all the forms with let and evaluates body" all the forms with let and evaluates the body"
[bindings & body] [bindings & body]
(def head (ast-unwrap1 bindings)) (def head (ast-unwrap1 bindings))
(tuple 'let head (tuple 'let head
@ -403,21 +403,21 @@ If no match is found, returns nil"
(array-slice functions 5 -1))))) (array-slice functions 5 -1)))))
(defn zipcoll (defn zipcoll
"Creates an table or tuple from two arrays/tuples. Result is table if no "Creates an table or tuple from two arrays/tuples. If a third argument of
third argument is given" :struct is givent resault is struct else is table."
[coll-1 coll-2 the-type] [coll-1 coll-2 the-type]
(var zipping-table @{}) (var zipping-table @{})
(def {:more more1 :next next1} (iter coll-1)) (def {:more more1 :next next1} (iter coll-1))
(def {:more more2 :next next2} (iter coll-2)) (def {:more more2 :next next2} (iter coll-2))
(while (and (more1) (more2)) (while (and (more1) (more2))
(put zipping-table (next1) (next2))) (put zipping-table (next1) (next2)))
(if (= :struct the-type) (if (struct? the-type)
(table-to-struct zipping-table) (table-to-struct zipping-table)
zipping-table)) zipping-table))
(defn update (defn update
"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 that 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 (get coll a-key) )
(put coll a-key (apply a-function old-value args))) (put coll a-key (apply a-function old-value args)))
@ -476,8 +476,8 @@ third argument is given"
:struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}")) :struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
}) })
(defn- default_printer [pp seen buf x] (defn- default_printer [pp seen buf x]
(buffer-push-string buf (describe x)) (buffer-push-string buf (describe x))
buf) buf)
(defn- pp1 [seen buf x] (defn- pp1 [seen buf x]
@ -497,10 +497,10 @@ third argument is given"
"Expand macros in a form, but do not recursively expand macros." "Expand macros in a form, but do not recursively expand macros."
[x] [x]
(defn doarray [a] (defn doarray [a]
(def len (length a)) (def len (length a))
(def newa []) (def newa [])
(for [i 0 len] (for [i 0 len]
(array-push newa (macroexpand1 (get a i)))) (array-push newa (macroexpand1 (get a i))))
newa) newa)
@ -535,7 +535,7 @@ third argument is given"
'quote identity 'quote identity
'var expandlast 'var expandlast
'while expandall 'while expandall
}) })
(defn dotup [t] (defn dotup [t]
(def h (get t 0)) (def h (get t 0))
@ -584,7 +584,7 @@ third argument is given"
(put newenv '_env @{:value newenv})) (put newenv '_env @{:value newenv}))
newenv) newenv)
(def run-context (def run-context
"Run a context. This evaluates expressions of dst in an environment, "Run a context. This evaluates expressions of dst in an environment,
and is encapsulates the parsing, compilation, and evaluation of dst. and is encapsulates the parsing, compilation, and evaluation of dst.
env is the environment to evaluate the code in, chunks is a function env is the environment to evaluate the code in, chunks is a function
@ -592,7 +592,7 @@ that returns strings or buffers of source code (from a repl, file,
network connection, etc. onvalue and onerr are callbacks that are network connection, etc. onvalue and onerr are callbacks that are
invoked when a result is returned and when an error is produced, invoked when a result is returned and when an error is produced,
respectively. respectively.
This function can be used to implemement a repl very easily, simply This function can be used to implemement a repl very easily, simply
pass a function that reads line from stdin to chunks, and print to pass a function that reads line from stdin to chunks, and print to
onvalue." onvalue."
@ -605,7 +605,7 @@ onvalue."
(var len 1) (var len 1)
(while (< 0 len) (while (< 0 len)
(buffer-clear buf) (buffer-clear buf)
(chunks buf) (chunks buf)
(:= len (length buf)) (:= len (length buf))
(for [i 0 len] (for [i 0 len]
(yield (get buf i)))) (yield (get buf i))))
@ -614,7 +614,7 @@ onvalue."
(var tempval nil) (var tempval nil)
# Stream of values # Stream of values
(def f (fiber (fn [] (def f (fiber (fn []
(def p (parser 1)) (def p (parser 1))
(while going (while going
(select (parser-status p) (select (parser-status p)
:full (yield (parser-produce p)) :full (yield (parser-produce p))
@ -626,8 +626,8 @@ onvalue."
(when (not= :root (parser-status p)) (when (not= :root (parser-status p))
(onerr "parse" "unexpected end of source")) (onerr "parse" "unexpected end of source"))
nil))) nil)))
(defn more [] (if temp true (defn more [] (if temp true
(do (do
(:= temp true) (:= temp true)
(:= tempval (resume f)) (:= tempval (resume f))
going))) going)))
@ -670,7 +670,7 @@ onvalue."
} (get st i)) } (get st i))
(file-write stdout " in") (file-write stdout " in")
(when c (file-write stdout " cfunction")) (when c (file-write stdout " cfunction"))
(when name (file-write stdout (string " " name))) (when name (file-write stdout (string " " name)))
(when func (file-write stdout (string " " func))) (when func (file-write stdout (string " " func)))
(when pc (file-write stdout (string " (pc=" pc ")"))) (when pc (file-write stdout (string " (pc=" pc ")")))
(when tail (file-write stdout " (tailcall)")) (when tail (file-write stdout " (tailcall)"))
@ -707,7 +707,7 @@ onvalue."
(put env (symbol (if prefix prefix "") k) v))))) (put env (symbol (if prefix prefix "") k) v)))))
(defmacro import [path & args] (defmacro import [path & args]
(apply tuple import* '_env path args)) (apply tuple import* '_env path args))
(defn repl [getchunk] (defn repl [getchunk]
(def newenv (make-env)) (def newenv (make-env))

26
src/compiler/specials.c
View File

@ -45,7 +45,7 @@ DstSlot dstc_astquote(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv)
} }
static void destructure(DstCompiler *c, Dst left, DstSlot right, static void destructure(DstCompiler *c, Dst left, DstSlot right,
void (*leaf)(DstCompiler *c, void (*leaf)(DstCompiler *c,
DstAst *ast, DstAst *ast,
const uint8_t *sym, const uint8_t *sym,
DstSlot s, DstSlot s,
@ -72,7 +72,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
localright = dstc_preread(c, ast, 0xFF, 1, right); localright = dstc_preread(c, ast, 0xFF, 1, right);
localsub = dstc_lslotn(c, 0xFF, 3); localsub = dstc_lslotn(c, 0xFF, 3);
if (i < 0x100) { if (i < 0x100) {
dstc_emit(c, ast, dstc_emit(c, ast,
(i << 24) | (i << 24) |
(localright << 16) | (localright << 16) |
(localsub << 8) | (localsub << 8) |
@ -80,7 +80,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
} else { } else {
DstSlot islot = dstc_cslot(dst_wrap_integer(i)); DstSlot islot = dstc_cslot(dst_wrap_integer(i));
int32_t locali = dstc_preread(c, ast, 0xFF, 2, islot); int32_t locali = dstc_preread(c, ast, 0xFF, 2, islot);
dstc_emit(c, ast, dstc_emit(c, ast,
(locali << 24) | (locali << 24) |
(localright << 16) | (localright << 16) |
(localsub << 8) | (localsub << 8) |
@ -111,7 +111,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
localright = dstc_preread(c, ast, 0xFF, 1, right); localright = dstc_preread(c, ast, 0xFF, 1, right);
localsub = dstc_lslotn(c, 0xFF, 3); localsub = dstc_lslotn(c, 0xFF, 3);
int32_t localk = dstc_preread(c, ast, 0xFF, 2, kslot); int32_t localk = dstc_preread(c, ast, 0xFF, 2, kslot);
dstc_emit(c, ast, dstc_emit(c, ast,
(localk << 24) | (localk << 24) |
(localright << 16) | (localright << 16) |
(localsub << 8) | (localsub << 8) |
@ -211,7 +211,7 @@ static DstSlot namelocal(DstCompiler *c, DstAst *ast, Dst head, int32_t flags, D
ret = localslot; ret = localslot;
} }
ret.flags |= flags; ret.flags |= flags;
dstc_nameslot(c, dst_unwrap_symbol(head), ret); dstc_nameslot(c, dst_unwrap_symbol(head), ret);
return ret; return ret;
} }
@ -276,7 +276,7 @@ static void defleaf(
tableindex = dstc_preread(c, ast, 0xFF, 1, tabslot); tableindex = dstc_preread(c, ast, 0xFF, 1, tabslot);
valsymindex = dstc_preread(c, ast, 0xFF, 2, valsym); valsymindex = dstc_preread(c, ast, 0xFF, 2, valsym);
valueindex = dstc_preread(c, ast, 0xFF, 3, s); valueindex = dstc_preread(c, ast, 0xFF, 3, s);
dstc_emit(c, ast, dstc_emit(c, ast,
(valueindex << 24) | (valueindex << 24) |
(valsymindex << 16) | (valsymindex << 16) |
(tableindex << 8) | (tableindex << 8) |
@ -352,7 +352,7 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
} }
/* Set target for compilation */ /* Set target for compilation */
target = (drop || tail) target = (drop || tail)
? dstc_cslot(dst_wrap_nil()) ? dstc_cslot(dst_wrap_nil())
: dstc_gettarget(opts); : dstc_gettarget(opts);
@ -366,7 +366,7 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
/* Condition left body */ /* Condition left body */
dstc_scope(c, 0); dstc_scope(c, 0);
left = dstc_value(bodyopts, truebody); left = dstc_value(bodyopts, truebody);
if (!drop && !tail) dstc_copy(c, ast, target, left); if (!drop && !tail) dstc_copy(c, ast, target, left);
dstc_popscope(c); dstc_popscope(c);
/* Compile jump to done */ /* Compile jump to done */
@ -377,7 +377,7 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
labelr = dst_v_count(c->buffer); labelr = dst_v_count(c->buffer);
dstc_scope(c, 0); dstc_scope(c, 0);
right = dstc_value(bodyopts, falsebody); right = dstc_value(bodyopts, falsebody);
if (!drop && !tail) dstc_copy(c, ast, target, right); if (!drop && !tail) dstc_copy(c, ast, target, right);
dstc_popscope(c); dstc_popscope(c);
/* Write jumps - only add jump lengths if jump actually emitted */ /* Write jumps - only add jump lengths if jump actually emitted */
@ -584,7 +584,7 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
dstc_freeslot(c, s); dstc_freeslot(c, s);
if (dstc_iserr(&opts)) return dstc_cslot(dst_wrap_nil()); if (dstc_iserr(&opts)) return dstc_cslot(dst_wrap_nil());
} }
/* Build function */ /* Build function */
def = dstc_pop_funcdef(c); def = dstc_pop_funcdef(c);
def->arity = arity; def->arity = arity;
@ -603,9 +603,9 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
(defindex << 16) | (defindex << 16) |
(localslot << 8) | (localslot << 8) |
DOP_CLOSURE); DOP_CLOSURE);
if (ret.index != localslot) { if (ret.index != localslot) {
dstc_emit(c, ast, dstc_emit(c, ast,
(ret.index << 16) | (ret.index << 16) |
(localslot << 8) | (localslot << 8) |
DOP_MOVE_FAR); DOP_MOVE_FAR);
@ -614,7 +614,7 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
return ret; return ret;
} }
/* Keep in lexographic order */ /* Keep in lexicographic order */
static const DstSpecial dstc_specials[] = { static const DstSpecial dstc_specials[] = {
{":=", dstc_varset}, {":=", dstc_varset},
{"ast-quote", dstc_astquote}, {"ast-quote", dstc_astquote},