kc3-lang/kc3/libkc3/env_eval_equal.c

• Show log

  Commit

• Hash : 06ef36ff
  Author : lyzer
  Date : 2025-09-15T17:35:27
  

  wip pdf parser
  

Download

• libkc3/env_eval_equal.c

• /* kc3
   * Copyright from 2022 to 2025 kmx.io <contact@kmx.io>
   *
   * Permission is hereby granted to use this software granted the above
   * copyright notice and this permission paragraph are included in all
   * copies and substantial portions of this software.
   *
   * THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF
   * PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE
   * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
   * THIS SOFTWARE.
   */
  #include <stdlib.h>
  #include "alloc.h"
  #include "array.h"
  #include "assert.h"
  #include "block.h"
  #include "call.h"
  #include "callable.h"
  #include "cfn.h"
  #include "compare.h"
  #include "complex.h"
  #include "cow.h"
  #include "data.h"
  #include "do_block.h"
  #include "env.h"
  #include "env_eval.h"
  #include "env_eval_equal.h"
  #include "fn.h"
  #include "frame.h"
  #include "ident.h"
  #include "list.h"
  #include "map.h"
  #include "ops.h"
  #include "pcallable.h"
  #include "pstruct.h"
  #include "pvar.h"
  #include "struct.h"
  #include "sw.h"
  #include "tag.h"
  #include "time.h"
  #include "tuple.h"
  #include "var.h"
  
  // TODO: unwind_protect
  bool env_eval_equal_cow (s_env *env, bool macro, s_cow *a,
                           s_cow *b, s_cow **dest)
  {
    s8 r;
    p_cow tmp = NULL;
    assert(env);
    assert(a);
    assert(b);
    assert(dest);
    (void) env;
    if ((r = compare_sym(a->type, b->type))) {
      err_puts("env_eval_equal_cow: type mismatch");
      assert(! "env_eval_equal_cow: type mismatch");
      return false;
    }
    if ((r = compare_tag(cow_read_only(a), cow_read_only(b)))) {
      err_puts("env_eval_equal_cow: value mismatch");
      assert(! "env_eval_equal_cow: value mismatch");
      return false;
    }
    if (macro) {
      tmp = cow_new_tag_copy(a->type, cow_read_only(a));
      if (! tmp)
        return false;
    }
    else
      if (! env_eval_pcow(env, &a, &tmp))
        return false;
    cow_freeze(tmp);
    *dest = tmp;
    return true;
  }
  
  // TODO: unwind_protect
  bool env_eval_equal_list (s_env *env, bool macro, s_list *a,
                            s_list *b, s_list **dest)
  {
    s_list *a_next;
    s_list *b_next;
    s_list *tmp = NULL;
    s_list **t;
    assert(env);
    assert(dest);
    t = &tmp;
    while (1) {
      if (! a && ! b) {
        *t = NULL;
        goto ok;
      }
      if (! a)
        goto ko;
      if (! b)
        goto ko;
      *t = list_new(NULL);
      if (! *t)
        goto ko;
      if (! env_eval_equal_tag(env, macro, &a->tag, &b->tag,
                               &(*t)->tag))
        goto ko;
      a_next = list_next(a);
      b_next = list_next(b);
      if (! a_next || ! b_next) {
        if (! env_eval_equal_tag(env, macro, &a->next, &b->next,
                                 &(*t)->next))
          goto ko;
        goto ok;
      }
      a = a_next;
      b = b_next;
      if (dest)
        t = &(*t)->next.data.plist;
    }
   ok:
    *dest = tmp;
    return true;
   ko:
    list_delete_all(tmp);
    return false;
  }
  
  // TODO: unwind protect
  bool env_eval_equal_map (s_env *env, bool macro, s_map *a,
                           s_map *b, s_map *dest)
  {
    s_map *c;
    uw i;
    uw j;
    s_tag tmp = {0};
    assert(env);
    assert(a);
    assert(b);
    assert(dest);
    if (! a->count) {
      map_init_copy(dest, b);
      return true;
    }
    if (! b->count) {
      map_init_copy(dest, a);
      return true;
    }
    if (a->count > b->count) {
      c = a;
      a = b;
      b = c;
    }
    i = 0;
    while (i < a->count) {
      j = 0;
      while (j < b->count) {
        if (! compare_tag(a->key + i, b->key + j)) {
          if (! env_eval_equal_tag(env, macro, a->value + i, b->value + j,
                                   &tmp)) {
            return false;
          }
          tag_clean(&tmp);
          goto next;
        }
        j++;
      }
      return false;
    next:
      i++;
    }
    map_init_copy(dest, b);
    return true;
  }
  
  // TODO: unwind_protect
  bool env_eval_equal_tag (s_env *env, bool macro, s_tag *a,
                           s_tag *b, s_tag *dest)
  {
    bool is_unbound_a;
    bool is_unbound_b;
    bool is_var_a = false;
    bool is_var_b = false;
    s_tag tmp_a;
    s_tag tmp_b;
    s_tag *var_a = NULL;
    s_tag *var_b = NULL;
    assert(env);
    assert(a);
    assert(b);
    assert(dest);
    tag_init_void(&tmp_a);
    tag_init_void(&tmp_b);
    if (a->type == TAG_PVAR) {
      var_a = &a->data.pvar->tag;
      if (a->data.pvar->bound) {
        while (a->data.pvar->bound) {
          a = var_a;
          var_a = &a->data.pvar->tag;
        }
      }
      else
        is_var_a = true;
    }
    if (b->type == TAG_PVAR) {
      var_b = &b->data.pvar->tag;
      if (b->data.pvar->bound) {
        while (b->data.pvar->bound) {
          b = var_b;
          var_b = &b->data.pvar->tag;
        }
      }
      else
        is_var_b = true;
    }
    is_unbound_a = a->type == TAG_IDENT;
    is_unbound_b = ! macro && (b->type == TAG_IDENT);
    if (is_unbound_a && is_unbound_b) {
      err_write_1("env_eval_equal_tag: unbound equal on both sides: ");
      err_inspect_ident(&a->data.ident);
      err_write_1(" = ");
      err_inspect_ident(&b->data.ident);
      err_write_1(".\nTo match an existing variable please use the"
                  " pin operator, e.g.: ");
      err_inspect_ident(&a->data.ident);
      err_write_1(" = ^ ");
      err_inspect_ident(&b->data.ident);
      err_write_1("\n");
      return false;
    }
    if (is_unbound_a || is_var_a) {
      if (macro)
        tag_init_copy(dest, b);
      else
        env_eval_tag(env, b, dest);
      if (is_var_a) {
        if (! var_set(a->data.pvar, dest))
          return false;
      }
      else {
        if (! frame_replace(env->frame, a->data.ident.sym, dest))
          return false;
      }
      return true;
    }
    if (is_unbound_b || is_var_b) {
      if (macro)
        tag_init_copy(dest, a);
      else
        env_eval_tag(env, a, dest);
      if (is_var_b) {
        if (! var_set(b->data.pvar, dest))
          return false;
      }
      else {
        if (! frame_replace(env->frame, b->data.ident.sym, dest))
          return false;
      }
      return true;
    }
    if (! macro &&
        a->type == TAG_PCALL) {
      if (! env_eval_tag(env, a, &tmp_a))
        return false;
      if (! env_eval_equal_tag(env, macro, &tmp_a, b, dest)) {
        tag_clean(&tmp_a);
        return false;
      }
      tag_clean(&tmp_a);
      return true;
    }
    if (! macro &&
        b->type == TAG_PCALL) {
      if (! env_eval_tag(env, b, &tmp_b))
        return false;
      if (! env_eval_equal_tag(env, macro, a, &tmp_b, dest)) {
        tag_clean(&tmp_b);
        return false;
      }
      tag_clean(&tmp_b);
      return true;
    }
    a = tag_resolve_cow(a);
    b = tag_resolve_cow(b);
    switch (a->type) {
    case TAG_F32:
    case TAG_F64:
    case TAG_F128:
    case TAG_INTEGER:
    case TAG_PCOMPLEX:
    case TAG_RATIO:
    case TAG_S8:
    case TAG_S16:
    case TAG_S32:
    case TAG_S64:
    case TAG_SW:
    case TAG_U8:
    case TAG_U16:
    case TAG_U32:
    case TAG_U64:
    case TAG_UW:
      switch (b->type) {
      case TAG_F32:
      case TAG_F64:
      case TAG_F128:
      case TAG_INTEGER:
      case TAG_PCOMPLEX:
      case TAG_RATIO:
      case TAG_S8:
      case TAG_S16:
      case TAG_S32:
      case TAG_S64:
      case TAG_SW:
      case TAG_U8:
      case TAG_U16:
      case TAG_U32:
      case TAG_U64:
      case TAG_UW:
        if (compare_tag(a, b)) {
          return false;
        }
        tag_init_copy(dest, a);
        return true;
      default:
        break;
      }
    default:
      break;
    }
    if (a->type != b->type) {
      if (! env->silence_errors) {
        err_write_1("env_eval_equal_tag: type mismatch: ");
        err_inspect_tag(a);
        err_write_1(" != ");
        err_inspect_tag(b);
        err_write_1("\n");
        err_stacktrace();
      }
      return false;
    }
    switch (a->type) {
    case TAG_VOID:
      tag_init_void(dest);
      return true;
    case TAG_MAP:
      dest->type = TAG_MAP;
      return env_eval_equal_map(env, macro, &a->data.map, &b->data.map,
                                &dest->data.map);
    case TAG_PLIST:
      tag_init_plist(dest, NULL);
      return env_eval_equal_list(env, macro, a->data.plist, b->data.plist,
                                 &dest->data.plist);
    /*
    case TAG_PSTRUCT:
      dest->type = TAG_PSTRUCT;
      return env_eval_equal_struct(env, macro, a->data.pstruct,
                                   b->data.pstruct, &dest->data.pstruct);
    */
    case TAG_TIME:
      dest->type = TAG_TIME;
      return env_eval_equal_time(env, macro, &a->data.time,
                                 &b->data.time, &dest->data.time);
    case TAG_TUPLE:
      dest->type = TAG_TUPLE;
      return env_eval_equal_tuple(env, macro, &a->data.tuple,
                                  &b->data.tuple, &dest->data.tuple);
    case TAG_ARRAY:
    case TAG_DO_BLOCK:
    case TAG_BOOL:
    case TAG_CHARACTER:
    case TAG_FACT:
    case TAG_IDENT:
    case TAG_PCALL:
    case TAG_PCALLABLE:
    case TAG_PFACTS:
    case TAG_POINTER:
    case TAG_PSTRUCT:
    case TAG_PSTRUCT_TYPE:
    case TAG_PSYM:
    case TAG_PTAG:
    case TAG_PTR:
    case TAG_PTR_FREE:
    case TAG_PVAR:
    case TAG_QUOTE:
    case TAG_STR:
      if (compare_tag(a, b)) {
        err_puts("env_eval_equal_tag: value mismatch");
        err_stacktrace();
        return false;
      }
      tag_init_copy(dest, a);
      return true;
    case TAG_F32:
    case TAG_F64:
    case TAG_F128:
    case TAG_INTEGER:
    case TAG_PCOMPLEX:
    case TAG_PCOW:
    case TAG_RATIO:
    case TAG_S8:
    case TAG_S16:
    case TAG_S32:
    case TAG_S64:
    case TAG_SW:
    case TAG_U8:
    case TAG_U16:
    case TAG_U32:
    case TAG_U64:
    case TAG_UNQUOTE:
    case TAG_UW:
      break;
    }
    err_puts("env_eval_equal_tag: invalid tag");
    assert(! "env_eval_equal_tag: invalid tag");
    abort();
    return false;
  }
  
  // TODO: unwind_protect
  bool env_eval_equal_time (s_env *env, bool macro, s_time *a,
                            s_time *b, s_time *dest)
  {
    s_tag *a2;
    s_tag  a_tag[2] = {0};
    s_tag *b2;
    s_tag  b_tag[2] = {0};
    const s_sym *sym_Sw = &g_sym_Sw;
    s_time tmp = {0};
    s_tag  tmp_tag[2] = {0};
    assert(env);
    assert(a);
    assert(b);
    assert(dest);
    if (! (a2 = a->tag)) {
      a2 = a_tag;
      a2[0].type = TAG_SW;
      a2[0].data.sw = a->tv_sec;
      a2[1].type = TAG_SW;
      a2[1].data.sw = a->tv_nsec;
    }
    if (! (b2 = b->tag)) {
      b2 = b_tag;
      b2[0].type = TAG_SW;
      b2[0].data.sw = b->tv_sec;
      b2[1].type = TAG_SW;
      b2[1].data.sw = b->tv_nsec;
    }
    if (! env_eval_equal_tag(env, macro, a2, b2, tmp_tag)) {
      return false;
    }
    if (! env_eval_equal_tag(env, macro, a2 + 1, b2 + 1, tmp_tag + 1)) {
      tag_clean(tmp_tag);
      return false;
    }
    if (! sw_init_cast(&tmp.tv_sec, &sym_Sw, tmp_tag)) {
      err_puts("env_eval_equal_time: sw_init_cast (tv_sec)");
      assert(! "env_eval_equal_time: sw_init_cast (tv_sec)");
      tag_clean(tmp_tag + 1);
      tag_clean(tmp_tag);
      return false;
    }
    if (! sw_init_cast(&tmp.tv_nsec, &sym_Sw, tmp_tag + 1)) {
      err_puts("env_eval_equal_time: sw_init_cast (tv_nsec)");
      assert(! "env_eval_equal_time: sw_init_cast (tv_nsec)");
      tag_clean(tmp_tag + 1);
      tag_clean(tmp_tag);
      return false;
    }
    *dest = tmp;
    return true;
  }
  
  // TODO: unwind_protect
  bool env_eval_equal_tuple (s_env *env, bool macro, s_tuple *a,
                             s_tuple *b, s_tuple *dest)
  {
    uw i;
    s_tuple tmp = {0};
    assert(env);
    assert(a);
    assert(b);
    assert(dest);
    if (a->count != b->count) {
      err_puts("env_eval_equal_tuple: tuple arity mismatch");
      assert(! "env_eval_equal_tuple: tuple arity mismatch");
      return false;
    }
    tuple_init(&tmp, a->count);
    i = 0;
    while (i < a->count) {
      if (! env_eval_equal_tag(env, macro, a->tag + i, b->tag + i,
                               tmp.tag + i)) {
        err_write_1("env_eval_equal_tuple: tuple tag mismatch index ");
        err_inspect_uw(i);
        err_write_1("\n");
        assert(! "env_eval_equal_tuple: tuple tag mismatch");
        tuple_clean(&tmp);
        return false;
      }
      i++;
    }
    *dest = tmp;
    return true;
  }
  

Download