builtin-programs/web/db-lib.folk

Claim the db library is [apply {{} {
    set cc [C]
    $cc cflags -I. -I./vendor/tracy/public
    $cc include "db.h"
    $cc include "common.h"
    $cc include "vendor/stb_ds.h"

    $cc code {
        typedef struct ListOfEdgeTo {
            size_t capacityEdges;
            size_t nEdges; // This is an estimate.
            uint64_t edges[];
        } ListOfEdgeTo;
        typedef struct GenRc {
            int16_t rc;

            int gen: 15;
            bool alive: 1;
        } GenRc;

        #include <pthread.h>
    }
    set dbCFd [open "db.c" r]; set dbC [read $dbCFd]; close $dbCFd
    $cc code [lindex [regexp -inline {typedef struct Destructor \{.*\} Destructor;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct DestructorSet \{.*\} DestructorSet;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct Statement \{.*\} Statement;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct Match \{.*\} Match;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct Hold \{.*\} Hold;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct StatementRefList \{.*\} StatementRefList;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct AtomicallyVersionList \{.*\} AtomicallyVersionList;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct AtomicallyVersion \{.*\} AtomicallyVersion;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct Atomically \{.*\} Atomically;} $dbC] 0]
    $cc code [lindex [regexp -inline {typedef struct Db \{.*\} Db;} $dbC] 0]
    $cc argtype StatementRef { StatementRef $argname; sscanf(Jim_String($obj), "s%d:%d", &$argname.idx, &$argname.gen); }
    $cc argtype MatchRef { MatchRef $argname; sscanf(Jim_String($obj), "m%d:%d", &$argname.idx, &$argname.gen); }

    $cc proc clauseToJimObj {Clause* clause} Jim_Obj* {
        Jim_Obj* termObjs[clause->nTerms];
        for (int i = 0; i < clause->nTerms; i++) {
            termObjs[i] = Jim_NewStringObj(interp, termPtr(clause->terms[i]), 
                                           termLen(clause->terms[i]));
        }
        return Jim_NewListObj(interp, termObjs, clause->nTerms);
    }

    $cc proc statementParentCount {Db* db StatementRef stmtRef} int {
        Statement* stmt = statementAcquire(db, stmtRef);
        if (stmt == NULL) { return -1; }
        int ret = stmt->parentCount;
        statementRelease(db, stmt);
        return ret;
    }
    $cc proc statementPtrCount {Db* db StatementRef stmtRef} int {
        Statement* stmt = statementAcquire(db, stmtRef);
        if (stmt == NULL) { return -1; }
        GenRc genRc = stmt->genRc;
        int ret = genRc.rc - 1;
        statementRelease(db, stmt);
        return ret;
    }
    $cc proc clause {Db* db StatementRef stmtRef} Jim_Obj* {
        Statement* stmt = statementAcquire(db, stmtRef);
        if (stmt == NULL) { return Jim_NewStringObj(interp, "(null)", -1); }
        Jim_Obj* ret = clauseToJimObj(statementClause(stmt));
        statementRelease(db, stmt);
        return ret;
    }
    $cc proc childMatches {Db* db StatementRef stmtRef} Jim_Obj* {
        Statement* stmt = statementAcquire(db, stmtRef);
        if (stmt == NULL) { return Jim_NewEmptyStringObj(interp); }

        pthread_mutex_lock(&stmt->childMatchesMutex);
        if (stmt->childMatches == NULL) {
            pthread_mutex_unlock(&stmt->childMatchesMutex);
            statementRelease(db, stmt);
            return Jim_NewEmptyStringObj(interp);
        }

        int nChildren = 0;
        Jim_Obj* childObjs[stmt->childMatches->nEdges];
        for (int i = 0; i < stmt->childMatches->nEdges; i++) {
            MatchRef child = { .val = stmt->childMatches->edges[i] };
            childObjs[nChildren++] = Jim_ObjPrintf("m%d:%d", child.idx, child.gen);
        }

        pthread_mutex_unlock(&stmt->childMatchesMutex);
        statementRelease(db, stmt);
        return Jim_NewListObj(interp, childObjs, nChildren);
    }

    $cc proc matchAcq {Db* db MatchRef matchRef} Match* {
        return matchAcquire(db, matchRef);
    }
    $cc proc matchRel {Db* db Match* match} void {
        matchRelease(db, match);
    }
    $cc proc matchPtrCount {Db* db MatchRef matchRef} int {
        Match* match = matchAcquire(db, matchRef);
        GenRc genRc = match->genRc;
        int ret = genRc.rc - 1;
        matchRelease(db, match);
        return ret;
    }
    $cc proc matchIsAlive {Db* db MatchRef matchRef} int {
        Match* match = matchAcquire(db, matchRef);
        GenRc genRc = match->genRc;
        int alive = genRc.alive;
        matchRelease(db, match);
        return alive;
    }
    $cc code {
        #define CHILD_STATEMENTS_REMOVING ((ListOfEdgeTo*)1)
    }
    $cc proc childStatements {Db* db MatchRef matchRef} Jim_Obj* {
        Match* match = matchAcquire(db, matchRef);
        if (match == NULL) { return Jim_NewStringObj(interp, "", -1); }

        pthread_mutex_lock(&match->childStatementsMutex);
        if (match->childStatements == NULL ||
            match->childStatements == CHILD_STATEMENTS_REMOVING) {

            pthread_mutex_unlock(&match->childStatementsMutex);
            matchRelease(db, match);
            return Jim_NewEmptyStringObj(interp);
        }

        int nChildren = 0;
        Jim_Obj* childObjs[match->childStatements->nEdges];
        for (int i = 0; i < match->childStatements->nEdges; i++) {
            StatementRef child = { .val = match->childStatements->edges[i] };
            childObjs[nChildren++] = Jim_ObjPrintf("s%d:%d", child.idx, child.gen);
        }

        pthread_mutex_unlock(&match->childStatementsMutex);
        matchRelease(db, match);
        return Jim_NewListObj(interp, childObjs, nChildren);
    }

    $cc proc countAliveStatements {Db* db} int {
      int count = 0;
      for (int i = 1; i < 65536; i++) {  // slot 0 is reserved
        GenRc genRc = db->statementPool[i].genRc;
        if (genRc.alive) {
          count++;
        }
      }
      return count;
    }

    $cc proc holds {Db* db} Jim_Obj* {
        Jim_Obj* retObj = Jim_NewListObj(interp, NULL, 0);

        mutexLock(&db->holdsMutex);
        for (int i = 0; i < shlen(db->holds); i++) {
            Hold* hold = &db->holds[i];

            Statement* stmt = statementAcquire(db, hold->statement);
            if (stmt == NULL) {
                fprintf(stderr, "db-lib: holds: WARNING: held statement on (%s) is invalid! (s%d:%d)\n",
                        hold->key, hold->statement.idx, hold->statement.gen);
                continue;
            }

            char* clauseStr = clauseToString(statementClause(stmt));
            Jim_Obj* holdObjv[] = {
                Jim_NewStringObj(interp, hold->key, -1),
                Jim_NewIntObj(interp, hold->version),
                Jim_ObjPrintf("s%d:%d", hold->statement.idx, hold->statement.gen),
                Jim_NewStringObj(interp, clauseStr, -1)
            };
            statementRelease(db, stmt);
            free(clauseStr);

            Jim_Obj* holdObj = Jim_NewListObj(interp, holdObjv,
                                              sizeof(holdObjv)/sizeof(holdObjv[0]));
            Jim_ListAppendElement(interp, retObj, holdObj);
        }
        mutexUnlock(&db->holdsMutex);

        return retObj;
    }

    $cc proc atomicallys {Db* db} Jim_Obj* {
        Jim_Obj* retObj = Jim_NewListObj(interp, NULL, 0);

        mutexLock(&db->atomicallysMutex);
        for (int i = 0; i < sizeof(db->atomicallys)/sizeof(db->atomicallys[0]); i++) {
            Atomically* atomically = &db->atomicallys[i];
            if (atomically->key == NULL) { continue; }

            // Count versions in allVersions list
            int versionCount = 0;
            AtomicallyVersionList* vl = atomically->allVersions;
            while (vl != NULL) {
                versionCount++;
                vl = vl->next;
            }

            // Get latest converged version info
            int latestConvergedNumber = -1;
            if (atomically->latestConvergedVersion != NULL) {
                latestConvergedNumber = atomically->latestConvergedVersion->number;
            }

            Jim_Obj* atomicallyObjv[] = {
                Jim_NewStringObj(interp, atomically->key, -1),
                Jim_NewIntObj(interp, latestConvergedNumber),
                Jim_NewIntObj(interp, versionCount)
            };

            Jim_Obj* atomicallyObj = Jim_NewListObj(interp, atomicallyObjv,
                                              sizeof(atomicallyObjv)/sizeof(atomicallyObjv[0]));
            Jim_ListAppendElement(interp, retObj, atomicallyObj);
        }
        mutexUnlock(&db->atomicallysMutex);

        return retObj;
    }

    return [$cc compile]
}}]