# SPDX-License-Identifier: BSD-2-Clause

BEGIN {
    N = 0
    N_at_last_gc = 0
    if(!GC_EVERY) GC_EVERY = 8192
    max_n = 0
    _GLOBALS = _nil()
    _MACROS = _nil()
}

function _string(s) {
    _STRING[++N] = s
    _TYPE[N] = "s"
    max_n += 1
    return N
}

function _defined_symbol(name) {
    if(name in _SYM_NAMES) {
        return _SYM_NAMES[name]
    } else {
        logg_err("symbol undefined: " name)
        exit 1
    }
}
        
function _symbol(name) {
    if(name in _SYM_NAMES) {
        return _SYM_NAMES[name]
    } else {
        _SYM_NUMBERS[++N] = name
        max_n += 1
        
        _SYM_NAMES[name] = N
        _TYPE[N] = "'"
#        logg_dbg("_symbol", name " interned as symbol number " N)
        return N
    }
}

function _nil() {
    return "nil"
}
function _is_null(c) {
    return (c == "nil");
}
function _true() {
    return "t"
}
function _false() {
    return "f"
}
function _lispify_bool(c) {
    return c ? "t" : "f"
}


function _number(value) {
    return "# " value
}

function _is_literal(value,        r) {
    # A value we have stored literally will be a string ("nil", "t",
    # "f", "# 0", as just above); adding the number 0 to it will
    # result in the number 0, not the value itself. A solitary number
    # is an index into the _TYPE, _CAR/_CDR, _SYM_NUMBERS and/or
    # _STRING; such a bare number plus 0 equals itself.
    return ((value+0)!=value)
}

function _atom_awk(value,       t) {
    if(_is_literal(value)) {
        return 1
    } else {
        t = _TYPE[value]
        if(t == "'") return 1
        else if(t == "s") return 1
        else return 0
    }
}

function _atom_lisp(value) {
    return _lispify_bool(_atom_awk(value))
}

function _eq_awk(a,b) {
    if(_is_literal(a)) {
        if(_is_literal(b)) {
            return (a == b)
        } else {
            return 0
        }
    } else {
        if(_TYPE[a] == _TYPE[b]) {
            return (a == b)
        } else {
            return 0
        }
    }
}

function _eq_lisp(a,b) {
    return _lispify_bool(_eq_awk(a,b))
}

function _cons(car, cdr,       contents) {
    _CAR[++N] = car
    _CDR[N] = cdr
    _TYPE[N] = "("
    #logg_dbg("_cons", N " has car " car " and cdr " cdr)
    return N
}

function _set_car(cons_index, newcar) {
    _CAR[cons_index] = newcar
}

function _set_cdr(cons_index, newcdr) {
    _CDR[cons_index] = newcdr
}

function _car(cons_index) {
    return _CAR[cons_index]
}

function _cdr(cons_index) {
    return _CDR[cons_index]
}

function _caar(cons_index,       tv, t, v) {
    return _car(_car(cons_index))
}

function _cadr(cons_index,       cdr) {
    return _car(_cdr(cons_index))
}

function _cdar(cons_index) {
    return _cdr(_car(cons_index))
}

function _cddr(cons_index) {
    return _cdr(_cdr(cons_index))
}

function _caaar(cons_index) {
    return _car(_car(_car(cons_index)))
}

function _caadr(cons_index,       tv, t, v) {
    return _car(_car(_cdr(cons_index)))
}

function _cadar(cons_index) {
    return _car(_cdr(_car(cons_index)))
}

function _caddr(cons_index,       tv, t, v) {
    return _car(_cdr(_cdr(cons_index)))
}

function _cdaar(cons_index) {
    return _cdr(_car(_car(cons_index)))
}

function _cdadr(cons_index) {
    return _cdr(_car(_cdr(cons_index)))
}

function _cddar(cons_index) {
    return _cdr(_cdr(_car(cons_index)))
}

function _cdddr(cons_index) {
    return _cdr(_cdr(_cdr(cons_index)))
}

function _nreverse(lis,      old_head, last_cdr, car, cdr) {
    old_head = lis
    last_cdr = _nil()
    #logg_dbg("_nreverse", "hi. lis is " lis)
    #logg_dbg("_nreverse", "the representation of lis is " _repr(lis))
    # if the list is null, this while body will happen zero times
    while(!_is_null(lis)) {
        #logg_dbg("_nreverse", "lis is " lis " containing " _repr(lis))
        if(_TYPE[lis] == "(") {
            #logg_dbg("_nreverse", "lis is cons " lis \
            #         " which contains " _CAR[lis] " . " _CDR[lis])
            cdr = _cdr(lis)
            _set_cdr(lis, last_cdr)
            last_cdr = lis
            lis = cdr
        } else {
            logg_err("_nreverse", "cannot reverse a non-list")
            exit 1
        }
    }
    # now last_cdr is the initially last item.
    return last_cdr
}

# "NCONC finds the end of A and then changes its cdr part to B." -
# [LFN], p. 47.
function _nconc(a, b, a_end) {
    # _atom_awk(_nil()) is true
    if(_atom_awk(a))
        return b
    for(a_end=a; !_atom_awk(_cdr(a_end)); a_end=_cdr(a_end));
    # a_end now is a cons with an atom as its cdr, such as maybe nil
    _set_cdr(a_end, b)
    return a
}

function _equal_awk(a, b) {
    # [LFN], p. 48
    if(_eq_awk(a, b)) return 1
    # if they were both atoms above, they weren't eq
    else if(_atom_awk(a)) return 0
    # a wasn't an atom above, but b is.
    else if(_atom_awk(b)) return 0
    # now they must both be lists; they are equal if all members are
    # equal. iterativized. if they have different lengths, one of the
    # members will be checked against nil.
    ans = 0
    for(; !_is_null(a) && !_is_null(b) &&
          (ans = _equal_awk(_car(a), _car(b)));
        a = _cdr(a) && b = _cdr(b));
    return ans
}
function _equal_lisp(a, b) {
    return _lispify_bool(_equal_awk(a, b))
}

# [LFN], p. 49, iterativized. this returns a cdr of lis or nil.
function _memq(thing, lis) {
    for(; !_is_null(lis) && !_eq_awk(thing, _car(lis));
        lis=_cdr(lis)) ;
    # if we got to the end without finding thing, lis is now nil
    return lis
}

# same as memq but with equal instead of eq
function _member(thing, lis) {
    for(; !_is_null(lis) && !_equal_awk(thing, _car(lis));
        lis=_cdr(lis)) ;
    return lis
}


function _assoc(sym, alis) {
    # _car(alis) is the first pair; _caar(alis) is the name
    for(;
        !_is_null(alis) && !_eq_awk(_caar(alis), sym);
        alis=_cdr(alis));
    if(_is_null(alis)) # we did not find sym.
        return _nil()
    else {
#        logg_dbg("_assoc", "found " _car(alis) " containing " _repr(_car(alis)))
        return _car(alis)
    }
}

function _addmacro(name, fun,    existing, a) {
#    logg_err("_addmacro", "attempt to macro " _repr(name))
    existing = _assoc(name, _MACROS)
    if(_is_null(existing)) {
        _MACROS = _cons(_cons(name, _cons(fun, _nil())), _MACROS)
    } else {
        # replace existing definition
        _set_cdr(existing, _cons(fun, _nil()))
    }

#    for(a=_MACROS; !_is_null(a); a=_cdr(a)) {
#        logg_dbg("_addmacro", "a macro exists at this time: " _repr(_caar(a)))
#    }
#    logg_err("_addmacro", "--")
    return name
}

function _awk_array_of_strings_to_list(a,      i, lis) {
    lis = _nil()
    # we can save an _nreverse here. let's do it.
    for(i=length(a); i>0; i--) {
        lis = _cons(_string(a[i]), lis)
    }
    return lis
}

# compare with _repr function in printer.awk
function _list_to_flat_awk_array_of_any(lis, a,      ia, c, t) {
    if(ia[1] == 0) ia[1] = 1
    for(; !_is_null(lis); lis=_cdr(lis)) {
        c = _car(lis)
        if(_is_literal(c)) {
            if(c ~ /^#/)        a[ia[1]++] = substr(c, 3)+0
            else if(c == "t")   a[ia[1]++] = "true"
            else if(c == "f")   a[ia[1]++] = "false"
            else if(c == "nil") a[ia[1]++] = "nil"
            else {
                logg_err("_list_to_flat_awk_array_of_any",
                         "unimplemented for literal <<" c ">>")
                a[ia[1]++] = "[?]"
            }
        } else {
            t = _TYPE[c]
            if(t == "s")       a[ia[1]++] = _STRING[c]
            else if(t == "'")  a[ia[1]++] = _SYM_NUMBERS[c]
            else if(t == "(")  _list_to_flat_awk_array_of_any(c, a, ia)
            else { # shouldn't happen
                logg_err("_list_to_flat_awk_array_of_any",
                         "unimplemented for nonliteral <<" c ">>")
            }
        }
    }
    return ia[1]
}

    
function _smoke_test_core() {
    x = _cons(_T, _cons(_string("foo"), _cons(_symbol("foo"), _NIL)))
    print x
    print _STR[1]
    print _repr(x)
}