diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index 9ba3c1c..5528aca 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -2287,6 +2287,37 @@ sw buf_inspect_tuple_size (const s_tuple *tuple)
return result;
}
+sw buf_inspect_unquote (s_buf *buf, const s_unquote *unquote)
+{
+ sw r;
+ sw result = 0;
+ s_buf_save save;
+ buf_save_init(buf, &save);
+ if ((r = buf_write_1(buf, "unquote ")) < 0)
+ goto clean;
+ result += r;
+ if ((r = buf_inspect_tag(buf, unquote->tag)) < 0)
+ goto restore;
+ r = result;
+ goto clean;
+ restore:
+ buf_save_restore_wpos(buf, &save);
+ clean:
+ buf_save_clean(buf, &save);
+ return r;
+}
+
+sw buf_inspect_unquote_size (const s_unquote *unquote)
+{
+ sw r;
+ sw result = 0;
+ result += strlen("unquote ");
+ if ((r = buf_inspect_tag_size(unquote->tag)) < 0)
+ return r;
+ result += r;
+ return result;
+}
+
sw buf_inspect_var (s_buf *buf, const s_tag *var)
{
sw r;
diff --git a/libc3/env.c b/libc3/env.c
index 803c0b5..9fd4b88 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -659,10 +659,14 @@ bool env_eval_progn (s_env *env, const s_list *program, s_tag *dest)
bool env_eval_quote (s_env *env, const s_quote *quote, s_tag *dest)
{
+ bool r;
assert(env);
assert(quote);
assert(dest);
- return env_eval_quote_tag(env, quote->tag, dest);
+ env->quote_level++;
+ r = env_eval_quote_tag(env, quote->tag, dest);
+ env->quote_level--;
+ return r;
}
bool env_eval_quote_array (s_env *env, const s_array *array,
@@ -704,6 +708,113 @@ bool env_eval_quote_array (s_env *env, const s_array *array,
return false;
}
+bool env_eval_quote_call (s_env *env, const s_call *call, s_tag *dest)
+{
+ const s_list *arg;
+ s_call tmp = {0};
+ s_list **tmp_arg_last;
+ assert(call);
+ assert(dest);
+ if (! ident_init_copy(&tmp.ident, &call->ident))
+ return false;
+ tmp_arg_last = &tmp.arguments;
+ arg = call->arguments;
+ while (arg) {
+ *tmp_arg_last = list_new(NULL);
+ if (! env_eval_quote_tag(env, &arg->tag, &(*tmp_arg_last)->tag))
+ goto ko;
+ arg = list_next(arg);
+ }
+ // TODO: copy cfn and fn ?
+ tmp.cfn = call->cfn;
+ tmp.fn = call->fn;
+ dest->type = TAG_CALL;
+ dest->data.call = tmp;
+ return true;
+ ko:
+ call_clean(&tmp);
+ return false;
+}
+
+bool env_eval_quote_map (s_env *env, const s_map *map, s_tag *dest)
+{
+ s_map tmp;
+ uw i = 0;
+ assert(env);
+ assert(map);
+ assert(dest);
+ if (! map_init(&tmp, map->count))
+ return false;
+ while (i < tmp.count) {
+ if (! env_eval_quote_tag(env, map->key + i, tmp.key + i) ||
+ ! env_eval_quote_tag(env, map->value + i, tmp.value + i))
+ goto ko;
+ i++;
+ }
+ dest->type = TAG_MAP;
+ dest->data.map = tmp;
+ return true;
+ ko:
+ map_clean(&tmp);
+ return false;
+}
+
+bool env_eval_quote_quote (s_env *env, const s_quote *quote, s_tag *dest)
+{
+ bool r;
+ s_quote tmp = {0};
+ assert(env);
+ assert(quote);
+ assert(dest);
+ tmp.tag = tag_new();
+ if (! tmp.tag)
+ return false;
+ env->quote_level++;
+ r = env_eval_quote_tag(env, quote->tag, tmp.tag);
+ env->quote_level--;
+ if (! r)
+ return false;
+ dest->type = TAG_QUOTE;
+ dest->data.quote = tmp;
+ return true;
+}
+
+bool env_eval_quote_struct (s_env *env, const s_struct *s, s_tag *dest)
+{
+ uw i;
+ s_struct *t;
+ s_tag tmp = {0};
+ assert(env);
+ assert(s);
+ assert(dest);
+ tmp.type = TAG_STRUCT;
+ t = &tmp.data.struct_;
+ if (s->data || ! s->tag) {
+ if (! struct_init_copy(t, s))
+ return false;
+ *dest = tmp;
+ return true;
+ }
+ t->type = s->type;
+ t->tag = calloc(t->type->map.count, sizeof(s_tag));
+ if (! t->tag) {
+ err_puts("env_eval_quote_struct: failed to allocate memory");
+ assert(! "env_eval_quote_struct: failed to allocate memory");
+ return false;
+ }
+ i = 0;
+ while (i < t->type->map.count) {
+ if (! env_eval_quote_tag(env, s->tag + i, t->tag + i))
+ goto ko;
+ i++;
+ }
+ *dest = tmp;
+ return true;
+ ko:
+ struct_clean(t);
+ return false;
+}
+
// Like tag_init_copy excepted that the unquote parts get evaluated.
bool env_eval_quote_tag (s_env *env, const s_tag *tag, s_tag *dest)
{
@@ -719,6 +830,8 @@ bool env_eval_quote_tag (s_env *env, const s_tag *tag, s_tag *dest)
return env_eval_quote_list(env, tag->data.list, dest);
case TAG_MAP:
return env_eval_quote_map(env, &tag->data.map, dest);
+ case TAG_QUOTE:
+ return env_eval_quote_quote(env, &tag->data.quote, dest);
case TAG_STR:
return env_eval_quote_str(env, &tag->data.str, dest);
case TAG_STRUCT:
@@ -741,7 +854,6 @@ bool env_eval_quote_tag (s_env *env, const s_tag *tag, s_tag *dest)
case TAG_PTAG:
case TAG_PTR:
case TAG_PTR_FREE:
- case TAG_QUOTE:
case TAG_S8:
case TAG_S16:
case TAG_S32:
@@ -765,6 +877,27 @@ bool env_eval_quote_tag (s_env *env, const s_tag *tag, s_tag *dest)
return true;
}
+bool env_eval_quote_unquote (s_env *env, const s_unquote *unquote, s_tag *dest)
+{
+ bool r;
+ s_tag tmp;
+ assert(env);
+ assert(unquote);
+ assert(dest);
+ if (env->unquote_level + 1 >= env->quote_level) {
+ err_puts("env_eval_quote_unquote: unquote outside of a quote");
+ assert(! "env_eval_quote_unquote: unquote outside of a quote");
+ return false;
+ }
+ env->unquote_level++;
+ r = env_eval_tag(env, unquote->tag, &tmp);
+ env->unquote_level--;
+ if (! r)
+ return false;
+ *dest = tmp;
+ return true;
+}
+
bool env_eval_str (s_env *env, const s_str *str, s_tag *dest)
{
bool r = true;
@@ -965,6 +1098,7 @@ s_env * env_init (s_env *env, int argc, char **argv)
return NULL;
}
env->quote_level = 0;
+ env->unquote_level = 0;
return env;
}
diff --git a/libc3/types.h b/libc3/types.h
index e9c0e65..250c502 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -585,6 +585,7 @@ struct env {
s_buf out;
s_list *path;
uw quote_level;
+ uw unquote_level;
s_unwind_protect *unwind_protect;
};