A Lisp implemented in AWK
# SPDX-License-Identifier: BSD-2-Clause

function _gc_mark_cell(n, dot_filename, d) {
#    logg_dbg("_gc_mark_cell", n, d)
    _MARK[n] = 1
    if(dot_filename)
        print " n" n " [fillcolor=green];" >>dot_filename
    return 1
}

function _gc_mark_list(lis, dot_filename, d,    i) {
    while(!_is_null(lis)) {
        i += _gc_mark_cell(lis, dot_filename, d)
        if(!_is_literal(_car(lis))) {
            if(_TYPE[_car(lis)] == "(") {
                i += _gc_mark_list(_car(lis), dot_filename, d+1)
            } else {
                i += _gc_mark_cell(_car(lis), dot_filename, d)
            }
        }
        if(_is_literal(_cdr(lis))) {
            if(_is_null(_cdr(lis))) {
                lis = _nil()
            } else {
                # pair
                logg_dbg("_gc_mark_list", "cdr is a literal. pair?", d)
                i += _gc_mark_cell(_cdr(lis), dot_filename, d)
                lis = _nil()
            }
        } else {
            if(_TYPE[_cdr(lis)] == "(") {
                # move along lis
                lis = _cdr(lis)
            } else {
                # a pair with a non-literal
                logg_dbg("_gc_mark_list",
                         "cdr " _cdr(lis) " is not a cons. pair?", d)
                i += _gc_mark_cell(_cdr(lis), dot_filename, d)
            }
        }
    }    
    return i
}

function _gc_sweep(dot_filename,    ngcd) {
    for(i in _TYPE) {
        if(i+0!=i) continue # no string keys please
        if(!(i in _MARK)) {
            t = _TYPE[i]
            if(t == "s") {
                delete _STRING[i]
                if(dot_filename)
                    print "    n" i " [fillcolor=lightpink]" >>dot_filename
            } else if(t == "(") {
                delete _CAR[i]
                delete _CDR[i]
                if(dot_filename)
                    print "    n" i " [fillcolor=lightcyan2]" >>dot_filename
            } else if(t == "'") {
                name = _SYM_NUMBERS[i]
                delete _SYM_NUMBERS[i]
                delete _SYM_NAMES[name]
                if(dot_filename) 
                    print "    n" i " [fillcolor=orange1]" >>dot_filename
            } else {
                if(dot_filename)
                    print "    n" i " [fillcolor=oldlace]" >>dot_filename
            }
            delete _TYPE[i]
            ngcd += 1
        }
    }
    return ngcd
}


function _gc_dot(envs, mark_filename, sweep_filename,    i, t, name, ngcd, nmarks) {
    # y'know... the envs given had better add up to everything, not
    # just globals and not just one stack of envs. hmm
    delete _MARK
    ngcd = 0
    logg_dbg("_gc", "marking")

    # at one point i had a more generic fix for this, but then it
    # unaccountably broke? this will work.
    for(i=1; i<=_symbol("%no-gc%"); i++) _MARK[i]=1
    
    if(mark_filename) print "" >mark_filename
    if(sweep_filename) print "" >sweep_filename
    nmarks = _gc_mark_list(envs, mark_filename, 0)
    logg_dbg("_gc", "sweeping")
    ngcd = _gc_sweep(sweep_filename)
#    _dump("post-gc")
    return _cons(_cons(_symbol("marks"),
                       _cons(_number(nmarks), _nil())),
                 _cons(_cons(_symbol("marked"),
                             _cons(_number(length(_MARK)), _nil())),
                       _cons(_cons(_symbol("collected"),
                                   _cons(_number(ngcd), _nil())),
                             _nil())))
}

function _gc(envs) {
    return _gc_dot(envs)
}