diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-10-24 06:09:52 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-10-24 06:09:52 -0700 |
| commit | 96f7e4ab111b641d2f26b97f75ef4d81151417a1 (patch) | |
| tree | dc7fae4f93bff8d2c0d1b67bd7b5a315e6d1bdae | |
| parent | a513b69fd9b1e0f3925f1e33d44fe127dbb858e5 (diff) | |
| download | txr-96f7e4ab111b641d2f26b97f75ef4d81151417a1.tar.gz txr-96f7e4ab111b641d2f26b97f75ef4d81151417a1.tar.bz2 txr-96f7e4ab111b641d2f26b97f75ef4d81151417a1.zip | |
Fix non-working quasiquote over struct literals.
Turns out that there is missing support for quasiquoting
over structs. Code analogous to the way vector and hash
literals are handled is missing for structs.
* eval.c (expand_qquote_rec): Handle struct_lit_s forms
specially, like hash_lit_s and vector_lit_s.
commit 1e5bc5708d5763f20a7774f9348e825304a51adc
* struct.c (make_struct_lit_s): New symbol variable.
(struct_init): Store interned sys:make-struct-lit symbol
into make_struct_lit_s, and use that to register the
function.
* struct.h (make_struct_lit_s): Declared.
* tests/012/struct.tl: Update struct literal quasiquote
test cases to reflect fixed behavior.
| -rw-r--r-- | eval.c | 4 | ||||
| -rw-r--r-- | struct.c | 5 | ||||
| -rw-r--r-- | struct.h | 2 | ||||
| -rw-r--r-- | tests/012/struct.tl | 7 |
4 files changed, 11 insertions, 7 deletions
@@ -2742,6 +2742,10 @@ static val expand_qquote_rec(val qquoted_form, val menv, } else if (sym == vector_lit_s) { val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl); return rlcp(list(vec_list_s, args, nao), qquoted_form); + } else if (sym == struct_lit_s) { + val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl); + val pairs = expand_qquote(rest(rest(qquoted_form)), menv, qq, unq, spl); + return rlcp(list(make_struct_lit_s, args, pairs, nao), qquoted_form); } else { val f = sym; val r = cdr(qquoted_form); @@ -88,7 +88,7 @@ struct struct_inst { val slot[1]; }; -val struct_type_s, meth_s, print_s; +val struct_type_s, meth_s, print_s, make_struct_lit_s; static cnum struct_id_counter; static val struct_type_hash; @@ -111,6 +111,7 @@ void struct_init(void) struct_type_s = intern(lit("struct-type"), user_package); meth_s = intern(lit("meth"), user_package); print_s = intern(lit("print"), user_package); + make_struct_lit_s = intern(lit("make-struct-lit"), system_package); struct_type_hash = make_hash(nil, nil, nil); slot_hash = make_hash(nil, nil, t); struct_type_finalize_f = func_n1(struct_type_finalize); @@ -131,7 +132,7 @@ void struct_init(void) reg_fun(intern(lit("make-struct"), user_package), func_n2v(make_struct)); reg_fun(intern(lit("make-lazy-struct"), user_package), func_n2(make_lazy_struct)); - reg_fun(intern(lit("make-struct-lit"), system_package), func_n2(make_struct_lit)); + reg_fun(make_struct_lit_s, func_n2(make_struct_lit)); reg_fun(intern(lit("copy-struct"), user_package), func_n1(copy_struct)); reg_fun(intern(lit("replace-struct"), user_package), func_n2(replace_struct)); reg_fun(intern(lit("clear-struct"), user_package), func_n2o(clear_struct, 1)); @@ -25,7 +25,7 @@ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -extern val struct_type_s, meth_s; +extern val struct_type_s, meth_s, make_struct_lit_s; val make_struct_type(val name, val super, val static_slots, val slots, val static_initfun, val initfun, val boactor, diff --git a/tests/012/struct.tl b/tests/012/struct.tl index a55e8447..cecdfb15 100644 --- a/tests/012/struct.tl +++ b/tests/012/struct.tl @@ -11,11 +11,10 @@ (b (inc x)))) (test ^#S(bar b ,(+ 2 2)) - (sys:struct-lit - bar b 4)) + #S(bar a 103 b 4)) -(test (sys:expand ^#S(bar b ,(+ 2 2))) - (sys:make-struct-lit 'bar '(b 4))) +(test (sys:expand '^#S(bar b ,(+ 2 2))) + (sys:make-struct-lit 'bar (list 'b (+ 2 2)))) (defvar s (eval ^#S(bar b ,(+ 2 2)))) |