mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-10-31 07:33:01 +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
parent 41d5b5cb90 9f90dc1e1f
commit 3c57980ef1
3 changed files with 50 additions and 52 deletions
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
#The following functions turn iterators to lazy seq and vice versa
(defn- iter-self
[next]
(delay (tuple (next) (iter-self next))))
(defn iter2lazy
"Create a lazy sequence froma an iterator"
"Create a lazy sequence from an iterator"
[iter]
(def {:more more :next next} iter)
(iter-self next))
(if (more)
(delay (tuple (next) (iter2lazy iter)))
empty-seq))
(defn lazy2iter
"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. Same is true for iterators
(defn filter2 [pred coll]
(tail (iter2lazy (filter pred coll))))
(defn filter2 [pred coll] (iter2lazy (filter pred coll)))
(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
# Copyright 2018 (C) Calvin Rose
(var *env*
(var *env*
"The current environment."
_env)
(def defn :macro
"Define a function"
(fn [name & more]
(fn [name & more]
(def fstart (fn recur [i]
(def ith (ast-unwrap1 (get more i)))
(def t (type ith))
@@ -23,7 +23,7 @@
"Define a macro."
(do
(def defn* (get (get _env 'defn) :value))
(fn [name & more]
(fn [name & more]
(def args (array-concat [] name :macro more))
(apply1 defn* args))))
@@ -86,7 +86,7 @@
(defmacro when
"Evaluates the body when the condition is true. Otherwise returns nil."
[cond & body]
[cond & body]
(tuple 'if cond (tuple-prepend body 'do)))
(defmacro cond
@@ -140,21 +140,21 @@ If no match is found, returns nil"
(tuple 'def sym dispatch)
(aux 0)))
(defmacro and [& forms]
(defmacro and [& forms]
(def len (length forms))
(if (= len 0) true ((fn aux [i]
(cond
(>= (inc i) len) (get forms i)
(tuple 'if (get forms i) (aux (inc i)) false))) 0)))
(defmacro or [& forms]
(defmacro or [& forms]
(def len (length forms))
(if (= len 0) false ((fn aux [i]
(cond
(>= (inc i) len) (get forms i)
(tuple 'if (get forms i) true (aux (inc i))))) 0)))
(defn identity
(defn identity
"A function that returns its first argument."
[x] x)
@@ -167,7 +167,7 @@ If no match is found, returns nil"
:next (fn []
(def ret (get x i))
(:= i (+ i 1))
ret)
ret)
})
(def iters {
:array array-iter
@@ -184,20 +184,20 @@ If no match is found, returns nil"
:next (fn []
(def ret i)
(:= i (+ i 1))
ret)
ret)
})
(defn range [top] (range2 0 top))
(defn doiter [itr]
(defn doiter [itr]
(def {:more more :next next} (iter itr))
(while (more) (next)))
(defn foreach [itr f]
(defn foreach [itr f]
(def {:more more :next next} (iter itr))
(while (more) (f (next))))
(defn iter2array [itr]
(defn iter2array [itr]
(def {:more more :next next} (iter itr))
(def a [])
(while (more) (array-push a (next)))
@@ -237,7 +237,7 @@ If no match is found, returns nil"
(def len (length head))
(var [i accum] [0 ['do]])
(while (< i len)
(array-push accum (tuple 'def
(array-push accum (tuple 'def
(get head i)
(get head (+ 1 i))))
(:= i (+ i 2)))
@@ -379,7 +379,7 @@ If no match is found, returns nil"
(defmacro when-let
"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]
(def head (ast-unwrap1 bindings))
(tuple 'let head
@@ -403,21 +403,21 @@ If no match is found, returns nil"
(array-slice functions 5 -1)))))
(defn zipcoll
"Creates an table or tuple from two arrays/tuples. Result is table if no
third argument is given"
"Creates an table or tuple from two arrays/tuples. If a third argument of
:struct is givent resault is struct else is table."
[coll-1 coll-2 the-type]
(var zipping-table @{})
(def {:more more1 :next next1} (iter coll-1))
(def {:more more2 :next next2} (iter coll-2))
(while (and (more1) (more2))
(put zipping-table (next1) (next2)))
(if (= :struct the-type)
(if (struct? the-type)
(table-to-struct zipping-table)
zipping-table))
(defn update
"Accepts a key argument and passes its associated value to a function.
The key, then is associated to that value"
"Accepts a key argument and passes its' associated value to a function.
The key then, is associated to the function's return value"
[coll a-key a-function & args]
(def old-value (get coll a-key) )
(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 "{" "}"))
})
(defn- default_printer [pp seen buf x]
(buffer-push-string buf (describe x))
(defn- default_printer [pp seen buf x]
(buffer-push-string buf (describe x))
buf)
(defn- pp1 [seen buf x]
@@ -497,10 +497,10 @@ third argument is given"
"Expand macros in a form, but do not recursively expand macros."
[x]
(defn doarray [a]
(defn doarray [a]
(def len (length a))
(def newa [])
(for [i 0 len]
(for [i 0 len]
(array-push newa (macroexpand1 (get a i))))
newa)
@@ -535,7 +535,7 @@ third argument is given"
'quote identity
'var expandlast
'while expandall
})
})
(defn dotup [t]
(def h (get t 0))
@@ -584,7 +584,7 @@ third argument is given"
(put newenv '_env @{:value newenv}))
newenv)
(def run-context
(def run-context
"Run a context. This evaluates expressions of dst in an environment,
and is encapsulates the parsing, compilation, and evaluation of dst.
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
invoked when a result is returned and when an error is produced,
respectively.
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
onvalue."
@@ -605,7 +605,7 @@ onvalue."
(var len 1)
(while (< 0 len)
(buffer-clear buf)
(chunks buf)
(chunks buf)
(:= len (length buf))
(for [i 0 len]
(yield (get buf i))))
@@ -614,7 +614,7 @@ onvalue."
(var tempval nil)
# Stream of values
(def f (fiber (fn []
(def p (parser 1))
(def p (parser 1))
(while going
(select (parser-status p)
:full (yield (parser-produce p))
@@ -626,8 +626,8 @@ onvalue."
(when (not= :root (parser-status p))
(onerr "parse" "unexpected end of source"))
nil)))
(defn more [] (if temp true
(do
(defn more [] (if temp true
(do
(:= temp true)
(:= tempval (resume f))
going)))
@@ -670,7 +670,7 @@ onvalue."
} (get st i))
(file-write stdout " in")
(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 pc (file-write stdout (string " (pc=" pc ")")))
(when tail (file-write stdout " (tailcall)"))
@@ -707,7 +707,7 @@ onvalue."
(put env (symbol (if prefix prefix "") k) v)))))
(defmacro import [path & args]
(apply tuple import* '_env path args))
(apply tuple import* '_env path args))
(defn repl [getchunk]
(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,
void (*leaf)(DstCompiler *c,
void (*leaf)(DstCompiler *c,
DstAst *ast,
const uint8_t *sym,
DstSlot s,
@@ -72,7 +72,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
localright = dstc_preread(c, ast, 0xFF, 1, right);
localsub = dstc_lslotn(c, 0xFF, 3);
if (i < 0x100) {
dstc_emit(c, ast,
dstc_emit(c, ast,
(i << 24) |
(localright << 16) |
(localsub << 8) |
@@ -80,7 +80,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
} else {
DstSlot islot = dstc_cslot(dst_wrap_integer(i));
int32_t locali = dstc_preread(c, ast, 0xFF, 2, islot);
dstc_emit(c, ast,
dstc_emit(c, ast,
(locali << 24) |
(localright << 16) |
(localsub << 8) |
@@ -111,7 +111,7 @@ static void destructure(DstCompiler *c, Dst left, DstSlot right,
localright = dstc_preread(c, ast, 0xFF, 1, right);
localsub = dstc_lslotn(c, 0xFF, 3);
int32_t localk = dstc_preread(c, ast, 0xFF, 2, kslot);
dstc_emit(c, ast,
dstc_emit(c, ast,
(localk << 24) |
(localright << 16) |
(localsub << 8) |
@@ -211,7 +211,7 @@ static DstSlot namelocal(DstCompiler *c, DstAst *ast, Dst head, int32_t flags, D
ret = localslot;
}
ret.flags |= flags;
dstc_nameslot(c, dst_unwrap_symbol(head), ret);
dstc_nameslot(c, dst_unwrap_symbol(head), ret);
return ret;
}
@@ -276,7 +276,7 @@ static void defleaf(
tableindex = dstc_preread(c, ast, 0xFF, 1, tabslot);
valsymindex = dstc_preread(c, ast, 0xFF, 2, valsym);
valueindex = dstc_preread(c, ast, 0xFF, 3, s);
dstc_emit(c, ast,
dstc_emit(c, ast,
(valueindex << 24) |
(valsymindex << 16) |
(tableindex << 8) |
@@ -352,7 +352,7 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
}
/* Set target for compilation */
target = (drop || tail)
target = (drop || tail)
? dstc_cslot(dst_wrap_nil())
: dstc_gettarget(opts);
@@ -366,7 +366,7 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
/* Condition left body */
dstc_scope(c, 0);
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);
/* 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);
dstc_scope(c, 0);
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);
/* 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);
if (dstc_iserr(&opts)) return dstc_cslot(dst_wrap_nil());
}
/* Build function */
def = dstc_pop_funcdef(c);
def->arity = arity;
@@ -603,9 +603,9 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
(defindex << 16) |
(localslot << 8) |
DOP_CLOSURE);
if (ret.index != localslot) {
dstc_emit(c, ast,
dstc_emit(c, ast,
(ret.index << 16) |
(localslot << 8) |
DOP_MOVE_FAR);
@@ -614,7 +614,7 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
return ret;
}
/* Keep in lexographic order */
/* Keep in lexicographic order */
static const DstSpecial dstc_specials[] = {
{":=", dstc_varset},
{"ast-quote", dstc_astquote},