slime/src/libslime.cpp

#define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE

#define _CRTDBG_MAP_ALLOC
#include <stdlib.h>

#include <stdio.h>
#include <time.h>
#include <string.h>
#include <cmath>
#include <ctype.h>
#include <stdarg.h>
#include <errno.h>
#include <new>
// #include <functional>

#ifdef _MSC_VER
#  include <crtdbg.h>
#  include <direct.h>
#  include <windows.h>
#else
#  include <unistd.h>
#  include <signal.h>
#endif

#include "ftb/types.hpp"
#include "ftb/arraylist.hpp"
#include "ftb/bucket_allocator.hpp"
#include "ftb/macros.hpp"
#include "ftb/profiler.hpp"

/*
  Forward declare the hash functions for the hashmap (needed at least
  for clang++)
*/
namespace Slime {struct Lisp_Object;}
bool hm_objects_match(char* a, char* b);
bool hm_objects_match(void* a, void* b);
bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b);
unsigned int hm_hash(char* str);
unsigned int hm_hash(void* ptr);
unsigned int hm_hash(Slime::Lisp_Object* obj);
#include "ftb/hashmap.hpp"

namespace Slime {
#    include "defines.cpp"
#    include "assert.hpp"
#    include "define_macros.hpp"
#    include "platform.cpp"
#    include "structs.cpp"
#    include "forward_decls.cpp"
}

bool hm_objects_match(char* a, char* b) {
    return strcmp(a, b) == 0;
}

bool hm_objects_match(void* a, void* b) {
    return a == b;
}

bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) {
    return Slime::lisp_object_equal(a, b);
}

unsigned int hm_hash(char* str) {
    unsigned int value = str[0] << 7;
    int i = 0;
    while (str[i]) {
        value = (10000003 * value) ^ str[i++];
    }
    return value ^ i;
}

unsigned int hm_hash(void* ptr) {
    return ((unsigned long long)ptr * 2654435761) % 4294967296;
}

unsigned int hm_hash(Slime::Lisp_Object* obj) {
    using namespace Slime;
    switch (Memory::get_type(obj)) {
        // hash from adress: if two objects of these types have
        // different addresses, they are different
    case Lisp_Object_Type::CFunction:
    case Lisp_Object_Type::Function:
    case Lisp_Object_Type::Symbol:
    case Lisp_Object_Type::Keyword:
    case Lisp_Object_Type::Continuation:
    case Lisp_Object_Type::Nil:
    case Lisp_Object_Type::T:
        return hm_hash((void*) obj);
        // hash from contents: even if objects are themselved
        // different, they cauld be equivalent:
    case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer);
    case Lisp_Object_Type::Number:  return hm_hash((void*) (unsigned long long)obj->value.number); // HACK(Felix): yes
    case Lisp_Object_Type::String:  return hm_hash((char*) &obj->value.string->data);
    case Lisp_Object_Type::Pair: {
        u32 hash = 1;
        for_lisp_list (obj) {
            hash <<= 1;
            hash += hm_hash(it);
        }
        return hash;
    } break;
    case Lisp_Object_Type::Vector:
    case Lisp_Object_Type::HashMap:
    default:
        create_not_yet_implemented_error();
        return 0;
    }
}

namespace Slime {
#    include "globals.cpp"
#    include "memory.cpp"
#    include "gc.cpp"
#    include "lisp_object.cpp"
#    include "error.cpp"
#    include "io.cpp"
#    include "env.cpp"
#    include "parse.cpp"
#    include "eval.cpp"
#    include "visualization.cpp"
#    include "docgeneration.cpp"
#    include "built_ins.cpp"
#    include "testing.cpp"
// #    include "undefines.cpp"
}