mirror of
https://github.com/janet-lang/janet
synced 2024-12-23 06:50:26 +00:00
Fix a compiler bug in the do special form.
This commit is contained in:
parent
a512e3e837
commit
3e1e258546
@ -4,23 +4,21 @@
|
||||
# that must be called (realizing it), and the memoized.
|
||||
# Use with (import "./path/to/this/file" :prefix "seq/")
|
||||
|
||||
(defn- mem0 [f]
|
||||
"Memoize a 0 arity function."
|
||||
(var state nil)
|
||||
(var loaded nil)
|
||||
(fn []
|
||||
(if loaded
|
||||
state
|
||||
(do
|
||||
(:= loaded true)
|
||||
(:= state (f))))))
|
||||
|
||||
# This creates one more closure than necessary but oh well
|
||||
(defmacro delay
|
||||
"Macro for lazy evaluation. Returns a function that will evaluate
|
||||
the body when invoked. If called a second time, will return the first return value
|
||||
that was memoized."
|
||||
[& forms] (tuple mem0 (apply tuple 'fn [] forms)))
|
||||
(defmacro delay [& forms]
|
||||
"Lazily evaluate a series of expressions. Returns a function that
|
||||
returns the result of the last expression. Will only evaluate the
|
||||
body once, and then memoizes the result."
|
||||
(def $state (gensym))
|
||||
(def $loaded (gensym))
|
||||
(tuple 'do
|
||||
(tuple 'var $state nil)
|
||||
(tuple 'var $loaded nil)
|
||||
(tuple 'fn (array)
|
||||
(tuple 'if $loaded
|
||||
$state
|
||||
(tuple 'do
|
||||
(tuple ':= $loaded true)
|
||||
(tuple ':= $state (tuple-prepend forms 'do)))))))
|
||||
|
||||
# Use tuples instead of structs to save memory
|
||||
(def HEAD :private 0)
|
||||
@ -63,13 +61,12 @@ that was memoized."
|
||||
[end]
|
||||
(range2 0 end))
|
||||
|
||||
(defn maps
|
||||
(defn map
|
||||
"Return a sequence that is the result of apply f to each value in s."
|
||||
[f s]
|
||||
(delay
|
||||
(def x (s))
|
||||
(if x (tuple (f (get x HEAD)) (maps f (get x TAIL))))))
|
||||
(def map maps)
|
||||
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
|
||||
|
||||
(defn realize
|
||||
"Force evaluation of a lazy sequence."
|
||||
@ -108,4 +105,3 @@ that was memoized."
|
||||
(when x
|
||||
(def thehead (get HEAD x))
|
||||
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
|
||||
|
||||
|
@ -305,8 +305,8 @@ If no match is found, returns nil"
|
||||
|
||||
# Start pretty printer
|
||||
(def pp (do
|
||||
(defn- pp-seq [pp seen buf a start end]
|
||||
(if (get seen a)
|
||||
(defn- pp-seq [pp seen buf a start end checkcycle]
|
||||
(if (and checkcycle (get seen a))
|
||||
(buffer-push-string buf "<cycle>")
|
||||
(do
|
||||
(put seen a true)
|
||||
@ -318,8 +318,8 @@ If no match is found, returns nil"
|
||||
(buffer-push-string buf end)))
|
||||
buf)
|
||||
|
||||
(defn- pp-dict [pp seen buf a start end]
|
||||
(if (get seen a)
|
||||
(defn- pp-dict [pp seen buf a start end checkcycle]
|
||||
(if (and checkcycle (get seen a))
|
||||
(buffer-push-string buf "<cycle>")
|
||||
(do
|
||||
(put seen a true)
|
||||
@ -336,9 +336,9 @@ If no match is found, returns nil"
|
||||
buf)
|
||||
|
||||
(def printers :private {
|
||||
:array (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]"))
|
||||
: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 "@{" "}"))
|
||||
: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 "{" "}"))
|
||||
})
|
||||
|
||||
|
@ -352,9 +352,9 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
|
||||
}
|
||||
|
||||
/* Set target for compilation */
|
||||
target = (!drop && !tail)
|
||||
? dstc_gettarget(opts)
|
||||
: dstc_cslot(dst_wrap_nil());
|
||||
target = (drop || tail)
|
||||
? dstc_cslot(dst_wrap_nil())
|
||||
: dstc_gettarget(opts);
|
||||
|
||||
/* Compile jump to right */
|
||||
condlocal = dstc_preread(c, ast, 0xFF, 1, cond);
|
||||
@ -393,7 +393,7 @@ DstSlot dstc_if(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
|
||||
* evaluate to the last expression in the body. */
|
||||
DstSlot dstc_do(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
|
||||
int32_t i;
|
||||
DstSlot ret;
|
||||
DstSlot ret = dstc_cslot(dst_wrap_nil());
|
||||
DstCompiler *c = opts.compiler;
|
||||
DstFopts subopts = dstc_fopts_default(c);
|
||||
(void) ast;
|
||||
@ -401,8 +401,8 @@ DstSlot dstc_do(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
|
||||
for (i = 0; i < argn; i++) {
|
||||
if (i != argn - 1) {
|
||||
subopts.flags = DST_FOPTS_DROP;
|
||||
} else if (opts.flags & DST_FOPTS_TAIL) {
|
||||
subopts.flags = DST_FOPTS_TAIL;
|
||||
} else {
|
||||
subopts = opts;
|
||||
}
|
||||
ret = dstc_value(subopts, argv[i]);
|
||||
if (i != argn - 1) {
|
||||
|
@ -31,7 +31,7 @@ DstKV *dst_struct_begin(int32_t count) {
|
||||
|
||||
/* Calculate capacity as power of 2 after 2 * count. */
|
||||
int32_t capacity = dst_tablen(2 * count);
|
||||
if (capacity < 0) capacity = dst_tablen(count);
|
||||
if (capacity < 0) capacity = dst_tablen(count + 1);
|
||||
|
||||
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(DstKV));
|
||||
char *data = dst_gcalloc(DST_MEMORY_STRUCT, s);
|
||||
@ -40,6 +40,7 @@ DstKV *dst_struct_begin(int32_t count) {
|
||||
dst_struct_length(st) = count;
|
||||
dst_struct_capacity(st) = capacity;
|
||||
dst_struct_hash(st) = 0;
|
||||
(dst_struct_raw(st)[3]) = 0;
|
||||
return st;
|
||||
}
|
||||
|
||||
@ -155,7 +156,7 @@ const DstKV *dst_struct_end(DstKV *st) {
|
||||
/* Get an item from a struct */
|
||||
Dst dst_struct_get(const DstKV *st, Dst key) {
|
||||
const DstKV *kv = dst_struct_find(st, key);
|
||||
if (NULL == kv || dst_checktype(kv->key, DST_NIL)) {
|
||||
if (NULL == kv) {
|
||||
return dst_wrap_nil();
|
||||
} else {
|
||||
return kv->value;
|
||||
|
@ -216,7 +216,7 @@ static void inc_counter(uint8_t *digits, int base, int len) {
|
||||
}
|
||||
|
||||
/* Generate a unique symbol. This is used in the library function gensym. The
|
||||
* symbol will be of the format prefix--XXXXXX, where X is a base64 digit, and
|
||||
* symbol will be of the format prefix_XXXXXX, where X is a base64 digit, and
|
||||
* prefix is the argument passed. */
|
||||
const uint8_t *dst_symbol_gen(const uint8_t *buf, int32_t len) {
|
||||
const uint8_t **bucket = NULL;
|
||||
@ -224,15 +224,14 @@ const uint8_t *dst_symbol_gen(const uint8_t *buf, int32_t len) {
|
||||
uint8_t counter[6] = {63, 63, 63, 63, 63, 63};
|
||||
/* Leave spaces for 6 base 64 digits and two dashes. That means 64^6 possible suffixes, which
|
||||
* is enough for resolving collisions. */
|
||||
int32_t newlen = len + 8;
|
||||
int32_t newlen = len + 7;
|
||||
int32_t newbufsize = newlen + 2 * sizeof(int32_t) + 1;
|
||||
uint8_t *str = (uint8_t *)dst_gcalloc(DST_MEMORY_SYMBOL, newbufsize) + 2 * sizeof(int32_t);
|
||||
dst_string_length(str) = newlen;
|
||||
memcpy(str, buf, len);
|
||||
str[len] = '-';
|
||||
str[len + 1] = '-';
|
||||
str[len] = '_';
|
||||
str[newlen] = 0;
|
||||
uint8_t *saltbuf = str + len + 2;
|
||||
uint8_t *saltbuf = str + len + 1;
|
||||
int status = 1;
|
||||
while (status) {
|
||||
int i;
|
||||
|
@ -20,5 +20,37 @@
|
||||
|
||||
(print "\nRunning Suite 1 Tests...\n")
|
||||
|
||||
(var num-tests-passed 0)
|
||||
(var num-tests-run 0)
|
||||
(def assert (fn [x e]
|
||||
(:= num-tests-run (+ 1 num-tests-run))
|
||||
(if x
|
||||
(do
|
||||
(print " \e[32m✔\e[0m " e)
|
||||
(:= num-tests-passed (+ 1 num-tests-passed))
|
||||
x)
|
||||
(do
|
||||
(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"))
|
||||
|
||||
(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")
|
||||
(assert (= (get test-struct 'a) 'b) "struct get")
|
||||
(assert (= :array (type (get test-struct 'het))) "struct get")
|
||||
|
||||
(defn myfun [x]
|
||||
(var a 10)
|
||||
(:= a (do
|
||||
(def y x)
|
||||
(if x 8 9))))
|
||||
|
||||
(assert (= (myfun true) 8) "check do form regression")
|
||||
(assert (= (myfun false) 9) "check do form regression")
|
||||
|
||||
(print "\n" num-tests-passed " of " num-tests-run " tests passed\n")
|
||||
(if (not= num-tests-passed num-tests-run) (exit 1))
|
||||
|
Loading…
Reference in New Issue
Block a user