protocols.c

Go to the documentation of this file.

/* -*- C -*-
 * Serene programming language
 * Copyright (C) 2019-2026 Sameer Rahmani <[email protected]>
 *
 * This library is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this library.  If not, see <https://www.gnu.org/licenses/>.
 */
 
#include "serene/rt/protocols.h"
 
#include "serene/rt/context.h"
#include "serene/rt/core.h"
#include "serene/rt/engine.h"
#include "serene/rt/impl/seq.h"
#include "serene/rt/keywords.h"
#include "serene/rt/lists.h"
#include "serene/rt/maps.h"
#include "serene/rt/namespaces.h"
#include "serene/rt/seqs.h"
#include "serene/rt/strings.h"
#include "serene/rt/symbols.h"
#include "serene/utils.h"
 
#include <string.h>
 
static inline srn_value_t *equality_to_value(bool cond) { return (int)cond ? &true_v : &false_v; }
 
srn_value_t *srn_value_eq(srn_context_t *ctx, const srn_value_t *a, const srn_value_t *b) {
  PANIC_IF_NULL(ctx);
  if (a == nullptr || b == nullptr || (a->type != b->type)) {
    return &false_v;
  }
 
  switch (a->type) {
  case VNil:
  case VTrue:
  case VFalse:
    // Tag-only values; matching tags means equal.
    return &true_v;
 
  case VI64:
    return equality_to_value(AS_I64(a) == AS_I64(b));
 
  case VF64:
    // IEEE compare: NaN != NaN, +0.0 == -0.0. Hash normalizes -0.0 -> +0.0
    // so the eq <=> hash invariant holds.
    return equality_to_value(AS_F64(a) == AS_F64(b));
 
  case VString:
    return equality_to_value(srn_string_eq(AS_STRING(a), AS_STRING(b)));
 
  case VSymbol:
    // Symbols are interned per namespace; pointer identity is enough.
    return equality_to_value(AS_SYMBOL(a) == AS_SYMBOL(b));
 
  case VKeyword:
    // Keywords are interned engine-wide; pointer identity is enough.
    return equality_to_value(AS_KEYWORD(a) == AS_KEYWORD(b));
 
  case VNamespace:
    // Namespaces are unique per engine; pointer identity suffices.
    return equality_to_value(AS_NS(a) == AS_NS(b));
 
  case VList: {
    srn_list_t *la = AS_LIST(a);
    srn_list_t *lb = AS_LIST(b);
    if (la->len != lb->len) {
      return &false_v;
    }
    srn_list_node_t *na = la->head;
    srn_list_node_t *nb = lb->head;
    while (na != nullptr) {
      if (srn_value_eq(ctx, na->value, nb->value) == &false_v) {
        return &false_v;
      }
      na = na->next;
      nb = nb->next;
    }
    return &true_v;
  }
 
  case VSeq: {
    srn_seq_t *sa = AS_SEQ(a);
    srn_seq_t *sb = AS_SEQ(b);
 
    if (sa->inner.len != sb->inner.len) {
      return &false_v;
    }
    for (size_t i = 0; i < sa->inner.len; i++) {
      seq_lookup_result_t ra = seq_get(ctx, &sa->inner, i);
      seq_lookup_result_t rb = seq_get(ctx, &sb->inner, i);
      if (ra.maybe_error != nullptr || rb.maybe_error != nullptr) {
        return &false_v;
      }
      if (srn_value_eq(ctx, (srn_value_t *)ra.data, (srn_value_t *)rb.data) == &false_v) {
        return &false_v;
      }
    }
    return &true_v;
  }
 
  case VMap:
    // Identity equality for now. Two maps compare equal iff they share the
    // same underlying CHAMT instance. Structural map equality is parked until
    // there's a real need (and a corresponding hmap walker).
    return equality_to_value(AS_MAP(a) == AS_MAP(b));
 
  case VClosure:
    return equality_to_value(AS_CLOSURE(a) == AS_CLOSURE(b));
 
  case VError:
    return equality_to_value(AS_ERROR(a) == AS_ERROR(b));
 
  case VQuote:
    TODO("VQuote payload is not defined yet");
 
  default:
    PANIC("Unknown value tag in srn_value_eq");
  }
}
 
// Combine two 32-bit hashes by hashing their concatenation. Order-sensitive.
static inline srn_hash_t combine2(srn_engine_t *engine, srn_hash_t a, srn_hash_t b) {
  srn_hash_t buf[2] = {a, b};
  return srn_hash(engine, buf, sizeof(buf));
}
 
srn_hash_t srn_value_hash(srn_context_t *ctx, const srn_value_t *v) {
  PANIC_IF_NULL(ctx);
  PANIC_IF_NULL(v);
 
  srn_engine_t *engine = ctx->engine;
 
  switch (v->type) {
  case VNil: {
    return 0;
  }
  case VTrue: {
    return 1;
  }
  case VFalse: {
    return 2;
  }
 
  case VI64: {
    int64_t n = AS_I64(v);
    return srn_hash(engine, &n, sizeof(n));
  }
 
  case VF64: {
    double d = AS_F64(v);
    return srn_hash(engine, &d, sizeof(d));
  }
 
  case VString: {
    srn_string_t *s = AS_STRING(v);
    return srn_hash(engine, s->buffer, s->len);
  }
 
  case VSymbol: {
    // Interned identity: hash the pointer bits.
    srn_symbol_t *sym = AS_SYMBOL(v);
    return srn_hash(engine, sym, sizeof(*sym));
  }
 
  case VKeyword: {
    // Interned; hash the pointer-sized payload (the name pointer).
    srn_keyword_t *k = AS_KEYWORD(v);
    return srn_hash(engine, k, sizeof(*k));
  }
 
  case VNamespace: {
    srn_namespace_t *ns = AS_NS(v);
    return srn_hash(engine, ns->name->buffer, ns->name->len);
  }
 
  case VList:
    // Lists are intentionally not hashable; they can't be used as map keys.
    // Use a seq or other container if you need a hashable sequence.
    PANIC("Lists are not hashable");
 
  case VSeq: {
    srn_seq_t *s = AS_SEQ(v);
    srn_hash_t h = srn_hash(engine, &s->inner.len, sizeof(s->inner.len));
 
    for (size_t i = 0; i < s->inner.len; i++) {
      seq_lookup_result_t r = seq_get(ctx, &s->inner, i);
      if (r.maybe_error != nullptr) {
        PANIC("Corrupted seq during hash");
      }
      srn_hash_t hi = srn_value_hash(ctx, (srn_value_t *)r.data);
      h = combine2(engine, h, hi);
    }
    return h;
  }
 
  case VMap: {
    PANIC("Hashmaps are not hashable");
  }
 
  case VClosure: {
    PANIC("Closures are not hashable");
  }
 
  case VError: {
    srn_error_t *e = AS_ERROR(v);
    return srn_hash(engine, e, sizeof(*e));
  }
 
  case VQuote:
    TODO("VQuote payload is not defined yet");
 
  default:
    PANIC("Unknown value tag in srn_value_hash");
  }
}