From b0c45fd15e3da1ee166155b3d6ed97b19876e2d6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 29 Nov 2018 13:30:59 -0500 Subject: [PATCH] Multisyms for easier access into structures. --- examples/life.janet | 10 +-- examples/newiter.janet | 73 ---------------- examples/primes.janet | 4 +- src/core/compile.c | 10 +-- src/core/compile.h | 6 ++ src/core/core.janet | 186 ++++++++++++++++++++--------------------- src/core/multisym.c | 111 ++++++++++++++++++++++++ src/core/specials.c | 25 +++--- test/suite1.janet | 10 +-- test/suite2.janet | 4 +- 10 files changed, 238 insertions(+), 201 deletions(-) delete mode 100644 examples/newiter.janet create mode 100644 src/core/multisym.c diff --git a/examples/life.janet b/examples/life.janet index 74a376f1..5a8ecaf8 100644 --- a/examples/life.janet +++ b/examples/life.janet @@ -1,21 +1,21 @@ # A game of life implementation (def- window - (fora [x :range [-1 2] + (seq [x :range [-1 2] y :range [-1 2] :when (not (and (zero? x) (zero? y)))] (tuple x y))) (defn- neighbors [[x y]] - (mapa (fn [[x1 y1]] (tuple (+ x x1) (+ y y1))) window)) + (map (fn [[x1 y1]] (tuple (+ x x1) (+ y y1))) window)) (defn tick "Get the next state in the Game Of Life." [state] (def cell-set (frequencies state)) (def neighbor-set (frequencies (mapcat neighbors state))) - (fora [coord :keys neighbor-set + (seq [coord :keys neighbor-set :let [count (get neighbor-set coord)] :when (or (= count 3) (and (get cell-set coord) (= count 2)))] coord)) @@ -24,7 +24,7 @@ "Draw cells in the game of life from (x1, y1) to (x2, y2)" [state x1 y1 x2 y2] (def cellset @{}) - (loop [cell :in state] (put cellset cell true)) + (each cell state (put cellset cell true)) (loop [x :range [x1 (+ 1 x2)] :after (print) y :range [y1 (+ 1 y2)]] @@ -37,7 +37,7 @@ (var *state* '[(0 0) (-1 0) (1 0) (1 1) (0 2)]) -(loop [i :range [0 20]] +(for i 0 20 (print "generation " i) (draw *state* -7 -7 7 7) (:= *state* (tick *state*))) diff --git a/examples/newiter.janet b/examples/newiter.janet deleted file mode 100644 index 88fc85c4..00000000 --- a/examples/newiter.janet +++ /dev/null @@ -1,73 +0,0 @@ -# Simpler iteration primitives example. - -(defn- iter-for - [prelude binding start end body] - (def $end (gensym)) - (tuple 'do - prelude - (tuple 'var binding start) - (tuple 'def $end end) - (tuple 'while (tuple < binding $end) - body - (tuple '++ binding)))) - -(defn- iter-keys - [prelude binding tab body] - (tuple 'do - prelude - (tuple 'var binding (tuple next tab nil)) - (tuple 'while (tuple not= nil binding) - body - (tuple := binding (tuple next tab binding))))) - -(defmacro do-range - "Iterate over a half open integer range." - [binding start end & body] - (def $iter (gensym)) - (iter-for nil $iter start end - (apply tuple 'do (tuple 'def binding $iter) body))) - -(defmacro each - "Iterate over an indexed data structure." - [binding ind & body] - (def $iter (gensym)) - (def $ind (gensym)) - (iter-for (tuple 'def $ind ind) - $iter 0 (tuple length $ind) - (apply tuple 'do (tuple 'def binding (tuple get $ind $iter)) body))) - - -(defmacro each-key - "Iterate over keys of a table or structure." - [binding tab & body] - (def $tab (gensym)) - (def $key (gensym)) - (iter-keys - (tuple 'def $tab tab) - $key - $tab - (apply tuple 'do (tuple 'def binding $key) body))) - -(defmacro each-value - "Iterate over values of a table or structure." - [binding tab & body] - (def $tab (gensym)) - (def $key (gensym)) - (iter-keys - (tuple 'def $tab tab) - $key - $tab - (apply tuple 'do (tuple 'def binding (tuple 'get $tab $key)) body))) - -(defmacro each-pair - "Iterate over keys and values of a table or structure." - [k v tab & body] - (def $tab (gensym)) - (def $key (gensym)) - (iter-keys - (tuple 'def $tab tab) - $key - $tab - (apply tuple 'do - (tuple 'def k $key) - (tuple 'def v (tuple 'get $tab $key)) body))) diff --git a/examples/primes.janet b/examples/primes.janet index f23e9a8f..d51ba7ea 100644 --- a/examples/primes.janet +++ b/examples/primes.janet @@ -4,10 +4,10 @@ "Returns a list of prime numbers less than n." [n] (def list @[]) - (loop [i :range [2 n]] + (for i 2 n (var isprime? true) (def len (length list)) - (loop [j :range [0 len]] + (for j 0 len (def trial (get list j)) (if (zero? (% i trial)) (:= isprime? false))) (if isprime? (array.push list i))) diff --git a/src/core/compile.c b/src/core/compile.c index 272294dc..755da529 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -421,14 +421,6 @@ static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) { JOP_MAKE_BUFFER); } -static JanetSlot janetc_symbol(JanetFopts opts, const uint8_t *sym) { - if (janet_string_length(sym) && sym[0] != ':') { - return janetc_resolve(opts.compiler, sym); - } else { - return janetc_cslot(janet_wrap_symbol(sym)); - } -} - /* Expand a macro one time. Also get the special form compiler if we * find that instead. */ static int macroexpand1( @@ -532,7 +524,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) { } break; case JANET_SYMBOL: - ret = janetc_symbol(opts, janet_unwrap_symbol(x)); + ret = janetc_sym_rvalue(opts, janet_unwrap_symbol(x)); break; case JANET_ARRAY: ret = janetc_array(opts, x); diff --git a/src/core/compile.h b/src/core/compile.h index 9311013e..abf54378 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -237,4 +237,10 @@ JanetSlot janetc_cslot(Janet x); /* Search for a symbol */ JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym); +/* Compile a symbol (or mutltisym) when used as an rvalue. */ +JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym); + +/* Compile an assignment to a symbol (or multisym) */ +JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value); + #endif diff --git a/src/core/core.janet b/src/core/core.janet index e3ffddee..825e9220 100644 --- a/src/core/core.janet +++ b/src/core/core.janet @@ -120,6 +120,7 @@ (defn true? "Check if x is true." [x] (= x true)) (defn false? "Check if x is false." [x] (= x false)) (defn nil? "Check if x is nil." [x] (= x nil)) +(defn empty? "Check if xs is empty." [xs] (= 0 (length xs))) (def atomic? "(atomic? x)\n\nCheck if x is a value that evaluates to itself when compiled." (do @@ -257,10 +258,10 @@ (defmacro loop "A general purpose loop macro. This macro is similar to the Common Lisp - loop macro, although intentonally much smaller in scope. - The head of the loop shoud be a tuple that contains a sequence of + loop macro, although intentionally much smaller in scope. + The head of the loop should be a tuple that contains a sequence of either bindings or conditionals. A binding is a sequence of three values - that define someting to loop over. They are formatted like:\n\n + that define something to loop over. They are formatted like:\n\n \tbinding :verb object/expression\n\n Where binding is a binding as passed to def, :verb is one of a set of keywords, and object is any janet expression. The available verbs are:\n\n @@ -388,7 +389,7 @@ (error (string "unexpected loop verb: " verb))))))) (tuple 'do (doone 0 nil) nil)) -(defmacro fora +(defmacro seq "Similar to loop, but accumulates the loop body into an array and returns that. See loop for details." [head & body] @@ -400,18 +401,6 @@ (tuple.prepend body 'do))) $accum)) -(defmacro for - "Similar to loop, but accumulates the loop body into a tuple and returns that. - See loop for details." - [head & body] - (def $accum (gensym)) - (tuple 'do - (tuple 'def $accum @[]) - (tuple 'loop head - (tuple array.push $accum - (tuple.prepend body 'do))) - (tuple tuple.slice $accum 0))) - (defmacro generate "Create a generator expression using the loop syntax. Returns a fiber that yields all values inside the loop in order. See loop for details." @@ -421,6 +410,16 @@ (tuple 'fn '[&] (tuple 'loop head (tuple yield (tuple.prepend body 'do)))))) +(defmacro for + "Do a c style for loop for side effects. Returns nil." + [binding start end & body] + (apply loop [tuple binding :range [tuple start end]] body)) + +(defmacro each + "Loop over each value in ind. Returns nil." + [binding ind & body] + (apply loop [tuple binding :in ind] body)) + (defn sum [xs] (var accum 0) (loop [x :in xs] (+= accum x)) @@ -498,7 +497,8 @@ (fn [x] (not (f x)))) (defn extreme - "Returns the most extreme value in args based on the orderer order. + "Returns the most extreme value in args based on the function order. + order should take two values and return true or false (a comparison). Returns nil if args is empty." [order args] (def len (length args)) @@ -514,6 +514,16 @@ (defn max-order [& args] (extreme order> args)) (defn min-order [& args] (extreme order< args)) +(defn first + "Get the first element from an indexed data structure." + [xs] + (get xs 0)) + +(defn last + "Get the last element from an indexed data structure." + [xs] + (get xs (- (length xs) 1))) + ### ### ### Indexed Combinators @@ -551,23 +561,20 @@ (sort-help a 0 (- (length a) 1) (or by order<))))) (defn sorted - "Returns the sorted version of an indexed data structure." - [ind by t &] - (def sa (sort (array.slice ind 0) by)) - (if (= :tuple (or t (type ind))) - (tuple.slice sa 0) - sa)) + "Returns a new sorted array without modifying the old one." + [ind by] + (sort (array.slice ind) by)) (defn reduce "Reduce, also know as fold-left in many languages, transforms an indexed type (array, tuple) with a function to produce a value." - [f init ind &] + [f init ind] (var res init) (loop [x :in ind] (:= res (f res x))) res) -(defn mapa +(defn map "Map a function over every element in an indexed data structure and return an array of the results." [f & inds] @@ -590,39 +597,29 @@ (put res i (apply f args)))) res) -(defn map - "Map a function over every element in an indexed data structure and - return a tuple of the results." - [f & inds] - (tuple.slice (apply mapa f inds) 0)) - (defn mapcat "Map a function over every element in an array or tuple and - use array to concatenate the results. Returns the type given - as the third argument, or same type as the input indexed structure." - [f ind t &] + use array to concatenate the results." + [f ind] (def res @[]) (loop [x :in ind] (array.concat res (f x))) - (if (= :tuple (or t (type ind))) - (tuple.slice res 0) - res)) + res) (defn filter "Given a predicate, take only elements from an array or tuple for - which (pred element) is truthy. Returns the type given as the - third argument, or the same type as the input indexed structure." + which (pred element) is truthy. Returns a new array." [pred ind t &] (def res @[]) (loop [item :in ind] (if (pred item) (array.push res item))) - (if (= :tuple (or t (type ind))) - (tuple.slice res 0) - res)) + res) (defn range - "Create an array of values [0, n)." + "Create an array of values [start, end) with a given step. + With one argument returns a range [0, end). With two arguments, returns + a range [start, end). With three, returns a range with optional step size." [& args] (case (length args) 1 (do @@ -635,7 +632,12 @@ (def arr (array.new n)) (loop [i :range [n m]] (put arr (- i n) i)) arr) - (error "expected 1 to 2 arguments to range"))) + 3 (do + (def [n m s] args) + (def arr (array.new n)) + (loop [i :range [n m s]] (put arr (- i n) i)) + arr) + (error "expected 1 to 3 arguments to range"))) (defn find-index "Find the index of indexed type for which pred is true. Returns nil if not found." @@ -657,11 +659,11 @@ (defn take-until "Given a predicate, take only elements from an indexed type that satisfy - the predicate, and abort on first failure. Returns a new tuple." + the predicate, and abort on first failure. Returns a new array." [pred ind] (def i (find-index pred ind)) (if i - (tuple.slice ind 0 i) + (array.slice ind 0 i) ind)) (defn take-while @@ -674,7 +676,7 @@ the predicate, and abort on first failure. Returns a new tuple." [pred ind] (def i (find-index pred ind)) - (tuple.slice ind i)) + (array.slice ind i)) (defn drop-while "Same as (drop-until (complement pred) ind)." @@ -682,6 +684,8 @@ (drop-until (complement pred) ind)) (defn juxt* + "Returns the juxtaposition of functions. In other words, + ((juxt* a b c) x) evaluates to ((a x) (b x) (c x))." [& funs] (fn [& args] (def ret @[]) @@ -690,6 +694,7 @@ (tuple.slice ret 0))) (defmacro juxt + "Macro form of juxt*. Same behavior but more efficient." [& funs] (def parts @['tuple]) (def $args (gensym)) @@ -729,39 +734,26 @@ (if (zero? (length more)) f (fn [& r] (apply f (array.concat @[] more r))))) -(defn every? [pred ind] +(defn every? + "Returns true if the predicate pred is true for every + value in ind, otherwise false." + [pred ind] (var res true) - (var i 0) - (def len (length ind)) - (while (< i len) - (def item (get ind i)) - (if (pred item) - (++ i) - (do (:= res false) (:= i len)))) + (loop [x :in ind :while res] + (if (pred x) (:= res false))) res) -(defn array.reverse +(defn 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 @[]) + (def len (length t)) + (var n (dec len)) + (def reversed (array.new len)) (while (>= n 0) (array.push reversed (get t n)) (-- n)) reversed) -(defn tuple.reverse - "Reverses the order of the elements given an array or tuple and returns a tuple" - [t] - (tuple.slice (array.reverse t) 0)) - -(defn reverse - "Reverses order of elements in a given array or tuple" - [t] - ((case (type t) - :tuple tuple.reverse - :array array.reverse) t)) - (defn invert "Returns a table of where the keys of an associative data structure are the values, and the values of the keys. If multiple keys have the same @@ -774,17 +766,16 @@ value, one key will be ignored." (defn zipcoll "Creates an table or tuple from two arrays/tuples. If a third argument of - :struct is given result is struct else is table." - [keys vals t &] + :struct is given result is struct else is table. Returns a new table." + [keys vals] (def res @{}) (def lk (length keys)) (def lv (length vals)) (def len (if (< lk lv) lk lv)) (loop [i :range [0 len]] (put res (get keys i) (get vals i))) - (if (= :struct t) - (table.to-struct res) - res)) + res) + (defn update "Accepts a key argument and passes its' associated value to a function. @@ -793,17 +784,26 @@ value, one key will be ignored." (def old-value (get coll a-key)) (put coll a-key (apply a-function old-value args))) +(defn merge-into + "Merges multiple tables/structs into a table. If a key appears in more than one + collection, then later values replace any previous ones. + Returns the original table." + [tab & colls] + (loop [c :in colls + key :keys c] + (put tab key (get c key))) + tab) + (defn merge "Merges multiple tables/structs to one. If a key appears in more than one collection, then later values replace any previous ones. - The type of the first collection determines the type of the resulting - collection" + Returns a new table." [& colls] (def container @{}) (loop [c :in colls key :keys c] (put container key (get c key))) - (if (table? (get colls 0)) container (table.to-struct container))) + container) (defn keys "Get the keys of an associative data structure." @@ -836,7 +836,7 @@ value, one key will be ignored." arr) (defn frequencies - "Get the number of occurences of each value in a indexed structure." + "Get the number of occurrences of each value in a indexed structure." [ind] (def freqs @{}) (loop @@ -852,10 +852,10 @@ value, one key will be ignored." (def res @[]) (def ncol (length cols)) (when (> ncol 0) - (def len (apply min (mapa length cols))) - (loop [i :range [0 len]] - (loop [ci :range [0 ncol]] - (array.push res (get (get cols ci) i))))) + (def len (apply min (map length cols))) + (loop [i :range [0 len] + ci :range [0 ncol]] + (array.push res (get (get cols ci) i)))) res) ### @@ -941,8 +941,8 @@ value, one key will be ignored." (defn expand-bindings [x] (case (type x) - :array (mapa expand-bindings x) - :tuple (map expand-bindings x) + :array (map expand-bindings x) + :tuple (tuple.slice (map expand-bindings x)) :table (dotable x expand-bindings) :struct (table.to-struct (dotable x expand-bindings)) (macroexpand-1 x))) @@ -958,16 +958,16 @@ value, one key will be ignored." 0)) (defn expandall [t] - (def args (mapa macroexpand-1 (tuple.slice t 1))) + (def args (map macroexpand-1 (tuple.slice t 1))) (apply tuple (get t 0) args)) (defn expandfn [t] (if (symbol? (get t 1)) (do - (def args (mapa macroexpand-1 (tuple.slice t 3))) + (def args (map macroexpand-1 (tuple.slice t 3))) (apply tuple 'fn (get t 1) (get t 2) args)) (do - (def args (mapa macroexpand-1 (tuple.slice t 2))) + (def args (map macroexpand-1 (tuple.slice t 2))) (apply tuple 'fn (get t 1) args)))) (def specs @@ -989,12 +989,12 @@ value, one key will be ignored." (cond s (s t) m? (apply m (tuple.slice t 1)) - (map macroexpand-1 t))) + (tuple.slice (map macroexpand-1 t)))) (def ret (case (type x) :tuple (dotup x) - :array (mapa macroexpand-1 x) + :array (map macroexpand-1 x) :struct (table.to-struct (dotable x macroexpand-1)) :table (dotable x macroexpand-1) x)) @@ -1154,7 +1154,7 @@ value, one key will be ignored." (var good true) (def f (fiber.new - (fn _thunk [&] + (fn [] (def res (compile source env where)) (if (= (type res) :function) (res) @@ -1211,7 +1211,7 @@ value, one key will be ignored." "\n") (when f (loop - [nf :in (array.reverse (fiber.lineage f)) + [nf :in (reverse (fiber.lineage f)) :before (file.write stderr " (fiber)\n") {:function func :tail tail @@ -1291,7 +1291,7 @@ value, one key will be ignored." (def last (get parts (- (length parts) 1))) (def normname (string.replace-all "." "/" path)) (array.push - (mapa (fn [x] + (map (fn [x] (def y (string.replace "??" last x)) (string.replace "?" normname y)) paths) diff --git a/src/core/multisym.c b/src/core/multisym.c new file mode 100644 index 00000000..4963e0e1 --- /dev/null +++ b/src/core/multisym.c @@ -0,0 +1,111 @@ +/* +* Copyright (c) 2018 Calvin Rose +* +* Permission is hereby granted, free of charge, to any person obtaining a copy +* of this software and associated documentation files (the "Software"), to +* deal in the Software without restriction, including without limitation the +* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +* sell copies of the Software, and to permit persons to whom the Software is +* furnished to do so, subject to the following conditions: +* +* The above copyright notice and this permission notice shall be included in +* all copies or substantial portions of the Software. +* +* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +* IN THE SOFTWARE. +*/ + +#include +#include "compile.h" +#include "emit.h" +#include "vector.h" + +/* Parse a part of a symbol that can be used for building up code. */ +static JanetSlot multisym_parse_part(JanetCompiler *c, const uint8_t *sympart, int32_t len) { + if (sympart[0] == ':') { + return janetc_cslot(janet_symbolv(sympart, len)); + } else { + int err = 0; + int32_t num = janet_scan_integer(sympart + 1, len - 1, &err); + if (err) { + return janetc_resolve(c, janet_symbol(sympart + 1, len - 1)); + } else { + return janetc_cslot(janet_wrap_integer(num)); + } + } +} + +static JanetSlot multisym_do_parts(JanetFopts opts, int put, const uint8_t *sym, Janet rvalue) { + JanetSlot slot; + JanetFopts subopts = janetc_fopts_default(opts.compiler); + int i, j; + for (i = 1, j = 0; sym[i]; i++) { + if (sym[i] == ':' || sym[i] == '@') { + if (j) { + JanetSlot target = janetc_gettarget(subopts); + JanetSlot value = multisym_parse_part(opts.compiler, sym + j, i - j); + janetc_emit_sss(opts.compiler, JOP_GET, target, slot, value, 1); + slot = target; + } else { + const uint8_t *nextsym = janet_symbol(sym + j, i - j); + slot = janetc_resolve(opts.compiler, nextsym); + } + j = i; + } + } + + if (j) { + /* multisym (outermost get or put) */ + JanetSlot target = janetc_gettarget(opts); + JanetSlot key = multisym_parse_part(opts.compiler, sym + j, i - j); + if (put) { + subopts.flags = JANET_FOPTS_HINT; + subopts.hint = target; + JanetSlot r_slot = janetc_value(subopts, rvalue); + janetc_emit_sss(opts.compiler, JOP_PUT, slot, key, r_slot, 0); + janetc_copy(opts.compiler, target, r_slot); + } else { + janetc_emit_sss(opts.compiler, JOP_GET, target, slot, key, 1); + } + return target; + } else { + /* normal symbol */ + if (put) { + JanetSlot ret, dest; + dest = janetc_resolve(opts.compiler, sym); + if (!(dest.flags & JANET_SLOT_MUTABLE)) { + janetc_cerror(opts.compiler, "cannot set constant"); + return janetc_cslot(janet_wrap_nil()); + } + subopts.flags = JANET_FOPTS_HINT; + subopts.hint = dest; + ret = janetc_value(subopts, rvalue); + janetc_copy(opts.compiler, dest, ret); + return ret; + } + return janetc_resolve(opts.compiler, sym); + } +} + +/* Check if a symbol is a multisym, and if so, transform + * it and emit the code for treating it as a bunch of nested + * gets. */ +JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym) { + if (janet_string_length(sym) && sym[0] != ':') { + return multisym_do_parts(opts, 0, sym, janet_wrap_nil()); + } else { + /* keyword */ + return janetc_cslot(janet_wrap_symbol(sym)); + } +} + +/* Check if a symbol is a multisym, and if so, transform + * it into the correct 'put' expression. */ +JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value) { + return multisym_do_parts(opts, 1, sym, value); +} diff --git a/src/core/specials.c b/src/core/specials.c index ec75a255..a9b98fd1 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -92,8 +92,8 @@ static int destructure(JanetCompiler *c, } static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) { - JanetFopts subopts = janetc_fopts_default(opts.compiler); - JanetSlot ret, dest; + /*JanetFopts subopts = janetc_fopts_default(opts.compiler);*/ + /*JanetSlot ret, dest;*/ Janet head; if (argn != 2) { janetc_cerror(opts.compiler, "expected 2 arguments"); @@ -104,16 +104,17 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) janetc_cerror(opts.compiler, "expected symbol"); return janetc_cslot(janet_wrap_nil()); } - dest = janetc_resolve(opts.compiler, janet_unwrap_symbol(head)); - if (!(dest.flags & JANET_SLOT_MUTABLE)) { - janetc_cerror(opts.compiler, "cannot set constant"); - return janetc_cslot(janet_wrap_nil()); - } - subopts.flags = JANET_FOPTS_HINT; - subopts.hint = dest; - ret = janetc_value(subopts, argv[1]); - janetc_copy(opts.compiler, dest, ret); - return ret; + return janetc_sym_lvalue(opts, janet_unwrap_symbol(head), argv[1]); + /*dest = janetc_resolve(opts.compiler, janet_unwrap_symbol(head));*/ + /*if (!(dest.flags & JANET_SLOT_MUTABLE)) {*/ + /*janetc_cerror(opts.compiler, "cannot set constant");*/ + /*return janetc_cslot(janet_wrap_nil());*/ + /*}*/ + /*subopts.flags = JANET_FOPTS_HINT;*/ + /*subopts.hint = dest;*/ + /*ret = janetc_value(subopts, argv[1]);*/ + /*janetc_copy(opts.compiler, dest, ret);*/ + /*return ret;*/ } /* Add attributes to a global def or var table */ diff --git a/test/suite1.janet b/test/suite1.janet index b84c9744..6e385eb0 100644 --- a/test/suite1.janet +++ b/test/suite1.janet @@ -167,13 +167,13 @@ (testmarsh (fn name [x] x) "marshal function 1") (testmarsh (fn [x] (+ 10 x 2)) "marshal function 2") (testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3") -(testmarsh mapa "marshal function 4") +(testmarsh map "marshal function 4") (testmarsh reduce "marshal function 5") (testmarsh (fiber.new (fn [] (yield 1) 2)) "marshal simple fiber 1") (testmarsh (fiber.new (fn [&] (yield 1) 2)) "marshal simple fiber 2") # Large functions -(def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i)))) +(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i)))) (array.push manydefs (tuple * 10000 3 5 7 9)) (def f (compile (tuple.prepend manydefs 'do) *env*)) (assert (= (f) (* 10000 3 5 7 9)) "long function compilation") @@ -206,15 +206,15 @@ (assert (= 7 (case :a :b 5 :c 6 :u 10 7)), "case with default") # Testing the loop and for macros -(def xs (apply tuple (for [x :range [0 10] :when (even? x)] (tuple (/ x 2) x)))) -(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "for macro 1") +(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x)))) +(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1") # Some testing for not= (assert (not= 1 1 0) "not= 1") (assert (not= 0 1 1) "not= 2") # Closure in while loop -(def closures (for [i :range [0 5]] (fn [] i))) +(def closures (seq [i :range [0 5]] (fn [] i))) (assert (= 0 ((get closures 0))) "closure in loop 0") (assert (= 1 ((get closures 1))) "closure in loop 1") (assert (= 2 ((get closures 2))) "closure in loop 2") diff --git a/test/suite2.janet b/test/suite2.janet index f2aa8090..ae106b8f 100644 --- a/test/suite2.janet +++ b/test/suite2.janet @@ -41,10 +41,10 @@ # Looping idea (def xs - (for [x :in '[-1 0 1], y :in '[-1 0 1] :when (not= x y 0)] (tuple x y))) + (seq [x :in '[-1 0 1], y :in '[-1 0 1] :when (not= x y 0)] (tuple x y))) (def txs (apply tuple xs)) -(assert (= txs '[[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested for") +(assert (= txs '[[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq") # Generators (def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))