path: root/awk/scheme/scheme/bin/vm.awk

#!/usr/bin/awk -f

# This is a stack-based virtual machine for executing compiled Scheme code
# It implements a simple instruction set with support for:
# - Basic arithmetic operations
# - Function calls and returns
# - Variable bindings and lookups
# - Cons cells and list operations

BEGIN {
    # Type system tags for runtime type checking
    T_NUMBER = "N"    # Numbers (integers)
    T_BOOLEAN = "B"   # Booleans (0/1)
    T_SYMBOL = "S"    # Symbols (identifiers)
    T_PAIR = "P"      # Cons cells (pairs)
    T_FUNCTION = "F"  # Function references
    T_NIL = "NIL"     # Empty list marker

    # Virtual machine registers
    stack_ptr = 0     # Points to top of evaluation stack
    heap_ptr = 0      # Points to next free heap location
    pc = 0            # Program counter for instruction fetch
    
    # Debug mode disabled by default, can be enabled via DEBUG=1 environment variable
    DEBUG = (ENVIRON["DEBUG"] == "1") ? 1 : 0

    # Environment for variable bindings
    env_size = 0     # Current size of environment stack
    
    # Function table for storing defined functions
    delete func_def_names  # Function names
    delete func_def_pc     # Entry points
    delete func_def_code   # Function bodies
    func_def_size = 0      # Number of defined functions
    
    # Call stack for function returns
    call_stack_ptr = 0

    # State persistence configuration
    STATE_FILE = "/tmp/scheme_vm.state"
    if (PERSIST) {
        debug("Loading state from: " STATE_FILE)
        if ((getline line < STATE_FILE) >= 0) {  # Check if file exists and is readable
            do {
                if (line ~ /^FUNC /) {
                    # Parse and load function definition
                    sub(/^FUNC /, "", line)
                    name = line
                    sub(/ .*$/, "", name)
                    code = line
                    sub(/^[^ ]+ /, "", code)
                    
                    debug("Loaded function: " name)
                    debug("Code: " code)
                    
                    # Store function in function table
                    func_def_names[func_def_size] = name
                    func_def_code[func_def_size] = code
                    func_def_size++
                }
            } while ((getline line < STATE_FILE) > 0)
            close(STATE_FILE)
        }
    }

    # Function environment storage
    delete func_env_names  # Variable names in function scope
    delete func_env_vals   # Variable values in function scope
    delete func_env_sizes  # Size of each function's environment

    # Global function registry
    delete FUNCTIONS       # Maps function names to implementations

    # Environment persistence configuration
    ENV_STATE_FILE = "/tmp/scheme_vm.env"
    if (PERSIST) {
        debug("Loading environment state from: " ENV_STATE_FILE)
        if ((getline line < ENV_STATE_FILE) >= 0) {
            do {
                if (line ~ /^ENV /) {
                    # Parse and load environment binding
                    sub(/^ENV /, "", line)
                    name = line
                    sub(/ .*$/, "", name)
                    val = line
                    sub(/^[^ ]+ /, "", val)
                    
                    debug("Loaded env var: " name " = " val)
                    
                    # Store in environment
                    env_name[env_size] = name
                    env_val[env_size] = val
                    env_size++
                }
            } while ((getline line < ENV_STATE_FILE) > 0)
            close(ENV_STATE_FILE)
        }
    }

    # Register built-in functions
    FUNCTIONS["+"] = "add"
    FUNCTIONS["-"] = "subtract"
    FUNCTIONS["*"] = "multiply"
    FUNCTIONS["/"] = "divide"
    FUNCTIONS["="] = "equals"
    FUNCTIONS["<"] = "less_than"
    FUNCTIONS[">"] = "greater_than"
    FUNCTIONS["add1"] = "add_one"

    # Track if VM halted normally (vs error)
    normal_exit = 0
}

# Debug output helper
function debug(msg) {
    if (DEBUG) printf("[DEBUG] %s\n", msg) > "/dev/stderr"
}

# Value constructors and accessors
# Values are stored as type:value pairs for runtime type checking
function makeValue(type, val) {
    return type ":" val
}

function getType(val) {
    type = substr(val, 1, index(val, ":") - 1)
    debug("Get type: " type " from " val)
    return type
}

function getValue(val) {
    value = substr(val, index(val, ":") + 1)
    debug("Get value: " value " from " val)
    return value
}

# Type checking predicates
function isNumber(val) { return getType(val) == T_NUMBER }
function isBoolean(val) { return getType(val) == T_BOOLEAN }
function isSymbol(val) { return getType(val) == T_SYMBOL }
function isPair(val) { return getType(val) == T_PAIR }
function isFunction(val) { return getType(val) == T_FUNCTION }
function isNil(val) { return getType(val) == T_NIL }

# Stack operations
function push(val) {
    stack[++stack_ptr] = val
    debug("Push: " val " (SP: " stack_ptr ")")
}

function pop() {
    if (stack_ptr < 1) error("Stack underflow")
    val = stack[stack_ptr--]
    debug("Pop: " val " (SP: " stack_ptr ")")
    return val
}

function peek() {
    if (stack_ptr < 1) error("Stack empty")
    debug("Peek: " stack[stack_ptr])
    return stack[stack_ptr]
}

# Heap operations for cons cells
function allocate(val) {
    heap[++heap_ptr] = val
    refs[heap_ptr] = 1  # Reference counting (not fully implemented)
    debug("Allocate: " val " at " heap_ptr)
    return heap_ptr
}

function getHeap(idx) {
    if (!(idx in heap)) {
        error("Invalid heap access: " idx)
        return ""
    }
    return heap[idx]
}

# Error handling
function error(msg) {
    print "Error at PC " pc ": " msg > "/dev/stderr"
    exit 1
}

# Arithmetic instruction implementations
function vm_add() {
    if (stack_ptr < 2) error("ADD requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) 
        error("ADD requires numeric operands")
    result = getValue(val1) + getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function vm_subtract() {
    if (stack_ptr < 2) error("SUB requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("SUB requires numeric operands")
    result = getValue(val1) - getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function vm_multiply() {
    if (stack_ptr < 2) error("MUL requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("MUL requires numeric operands")
    result = getValue(val1) * getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function vm_divide() {
    if (stack_ptr < 2) error("DIV requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("DIV requires numeric operands")
    if (getValue(val2) == 0)
        error("Division by zero")
    result = getValue(val1) / getValue(val2)
    push(makeValue(T_NUMBER, result))
}

# List operation implementations
function vm_cons() {
    if (stack_ptr < 2) error("CONS requires two operands")
    val2 = pop()
    val1 = pop()
    pair_val = val1 "," val2
    pair_idx = allocate(pair_val)
    push(makeValue(T_PAIR, pair_idx))
}

function vm_car() {
    if (stack_ptr < 1) error("CAR requires one operand")
    val = pop()
    if (!isPair(val)) error("CAR requires pair operand")
    pair_idx = getValue(val)
    pair = getHeap(pair_idx)
    car_val = substr(pair, 1, index(pair, ",") - 1)
    push(car_val)
}

function vm_cdr() {
    if (stack_ptr < 1) error("CDR requires one operand")
    val = pop()
    if (!isPair(val)) error("CDR requires pair operand")
    pair_idx = getValue(val)
    pair = getHeap(pair_idx)
    cdr_val = substr(pair, index(pair, ",") + 1)
    push(cdr_val)
}

# Comparison operations
function vm_equal() {
    if (stack_ptr < 2) error("EQ requires two operands")
    val2 = pop()
    val1 = pop()
    result = (val1 == val2) ? "1" : "0"
    debug("Equal comparison: " val1 " == " val2 " -> " result)
    push(makeValue(T_BOOLEAN, result))
}

function vm_less_than() {
    if (stack_ptr < 2) error("LT requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("LT requires numeric operands")
    result = (getValue(val1) < getValue(val2)) ? "1" : "0"
    debug("Less than comparison: " val1 " < " val2 " -> " result)
    push(makeValue(T_BOOLEAN, result))
}

# Main instruction execution loop
function execute(instr) {
    split(instr, parts, " ")
    op = parts[1]
    debug("Execute: " instr)
    
    # Dispatch based on instruction opcode
    if (op == "PUSH_CONST") {
        push(parts[2])
    }
    else if (op == "POP") {
        pop()
    }
    else if (op == "DUP") {
        val = peek()
        push(val)
    }
    else if (op == "SWAP") {
        if (stack_ptr < 2) error("SWAP requires two operands")
        val2 = pop()
        val1 = pop()
        push(val2)
        push(val1)
    }
    else if (op == "ADD") {
        vm_add()
    }
    else if (op == "SUB") {
        vm_subtract()
    }
    else if (op == "MUL") {
        vm_multiply()
    }
    else if (op == "DIV") {
        vm_divide()
    }
    else if (op == "CONS") {
        vm_cons()
    }
    else if (op == "CAR") {
        vm_car()
    }
    else if (op == "CDR") {
        vm_cdr()
    }
    else if (op == "EQ") {
        vm_equal()
    }
    else if (op == "LT") {
        vm_less_than()
    }
    else if (op == "PRINT") {
        if (stack_ptr < 1) error("PRINT requires one operand")
        print peek()
    }
    else if (op == "HALT") {
        normal_exit = 1
        if (stack_ptr > 0) {
            result = peek()
        }
        if (PERSIST) {
            save_state()
        }
        if (result) {
            print result
        }
        exit(0)
    }
    else if (op == "STORE") {
        vm_store(parts[2])
    }
    else if (op == "POP_ENV") {
        vm_pop_env()
    }
    else if (op == "LOOKUP") {
        vm_lookup(parts[2])
    }
    else if (op == "LABEL") {
        vm_define_function(parts[2], pc)
    }
    else if (op == "CALL") {
        vm_call_function(parts[2])
    }
    else if (op == "RETURN") {
        vm_return()
    }
    else if (op == "GET_VALUE") {
        vm_get_value()
    }
    else {
        error("Unknown instruction: " op)
    }
}

# Load program instructions
{
    program[NR-1] = $0
}

# Main execution loop
END {
    while (pc < length(program)) {
        execute(program[pc++])
    }
    
    # Save state if we didn't halt normally
    if (!normal_exit && PERSIST) {
        save_state()
    }
}

# Variable binding implementation
function vm_store(name) {
    debug("Storing " peek() " as " name " at env_size: " env_size)
    
    # Handle global definitions specially
    if (lookup_no_error("from_define")) {
        name = "__global_" name
        # Clear the define flag
        for (i = env_size - 1; i >= 0; i--) {
            if (env_name[i] == "from_define") {
                env_size--
                break
            }
        }
        
        # Remove any previous definition of this global
        for (i = env_size - 1; i >= 0; i--) {
            if (env_name[i] == name) {
                # Shift everything down
                for (j = i; j < env_size - 1; j++) {
                    env_name[j] = env_name[j + 1]
                    env_val[j] = env_val[j + 1]
                }
                env_size--
                break
            }
        }
    }
    
    # Handle lambda functions
    val = peek()
    if (isSymbol(val)) {
        func_name = getValue(val)
        if (func_name ~ /^__lambda_/) {
            # Store the function code under the new name
            FUNCTIONS[name] = FUNCTIONS[func_name]
            # Store the new name in the environment
            env_name[env_size] = name
            env_val[env_size] = makeValue(T_SYMBOL, name)
            env_size++
            return
        }
    }
    
    # Add to environment
    env_name[env_size] = name
    env_val[env_size] = peek()
    env_size++
    
    debug("Environment after store:")
    dump_env()
}

# Remove top binding from environment
function vm_pop_env() {
    if (env_size <= 0) error("Environment underflow")
    debug("Popping environment at size: " env_size)
    
    # Don't pop globals
    if (env_name[env_size-1] ~ /^__global_/) {
        debug("Keeping global definition: " env_name[env_size-1])
        return
    }
    
    debug("Removing: " env_name[env_size-1] " = " env_val[env_size-1])
    env_size--
}

# Variable lookup implementation
function vm_lookup(name, i, global_name, val) {
    debug("Looking up " name " in environment of size: " env_size)
    dump_env()
    
    # Check if it's a function (built-in or user-defined)
    if (name in FUNCTIONS) {
        debug("Found function: " name)
        push(makeValue(T_SYMBOL, name))
        return
    }
    
    # Try global name first, then local
    global_name = "__global_" name
    for (i = env_size - 1; i >= 0; i--) {
        if (env_name[i] == global_name || env_name[i] == name) {
            debug("Found " name " = " env_val[i] " at position " i)
            push(env_val[i])
            return
        }
    }
    error("Undefined variable: " name)
}

# Function definition implementation
function vm_define_function(name, start_pc) {
    debug("Defining function: " name " at " start_pc)
    
    # Build function code
    code = ""
    i = start_pc
    while (i < length(program) && program[i] != "RETURN") {
        if (code != "") code = code "\n"
        code = code program[i]
        i++
    }
    code = code "\nRETURN"
    
    # Store function
    debug("Storing function: " name " = " code)
    FUNCTIONS[name] = code
    
    pc = i + 1
}

# Function call implementation
function vm_call_function(func_name, code_lines, j, saved_pc, saved_env_size, arg, param_name) {
    debug("Calling function: " func_name)
    
    # If name is a symbol, get its value
    if (isSymbol(func_name)) {
        func_name = getValue(func_name)
    }
    
    # Handle anonymous functions
    if (func_name ~ /^__lambda_/) {
        if (!(func_name in FUNCTIONS)) {
            error("Undefined lambda function: " func_name)
        }
    } else if (!(func_name in FUNCTIONS)) {
        error("Undefined function: " func_name)
    }
    
    saved_pc = pc
    saved_env_size = env_size
    
    # Split function code into lines
    split(FUNCTIONS[func_name], code_lines, "\n")
    
    # Add function code to program at current position
    for (j in code_lines) {
        program[pc + j - 1] = code_lines[j]
    }
    
    # Check if this is a parameterized function
    if (code_lines[1] ~ /^STORE /) {
        # This is a parameterized function (lambda)
        # Get parameter name from STORE instruction
        param_name = substr(code_lines[1], 7)
        debug("Found parameter name: " param_name)
        
        # Get argument from stack
        arg = pop()
        debug("Function argument: " arg)
        
        # Create new environment frame
        debug("Creating new environment frame at size: " env_size)
        env_name[env_size] = param_name
        env_val[env_size] = arg
        env_size++
    } else {
        # This is a built-in function or non-parameterized function
        debug("Calling non-parameterized function: " func_name)
    }
    
    # Save return info and jump to function
    call_stack[++call_stack_ptr] = saved_pc
    env_stack[call_stack_ptr] = saved_env_size
    
    debug("Function found, jumping to PC: " pc " with env_size: " saved_env_size)
    dump_env()
}

# Function return implementation
function vm_return() {
    if (call_stack_ptr > 0) {
        # Save return value
        ret_val = pop()
        
        # Restore environment
        while (env_size > env_stack[call_stack_ptr]) {
            debug("Popping environment at size: " env_size)
            vm_pop_env()
        }
        
        # Restore program counter
        pc = call_stack[call_stack_ptr--]
        
        # Push return value
        push(ret_val)
        
        debug("Returned with value: " ret_val " and env_size: " env_size)
    }
}

# Debug helper to dump environment contents
function dump_env(    i) {
    debug("Environment dump:")
    for (i = 0; i < env_size; i++) {
        debug(sprintf("  %d: %s = %s", i, env_name[i], env_val[i]))
    }
}

# Helper for checking variable existence without error
function lookup_no_error(name,    i) {
    for (i = env_size - 1; i >= 0; i--) {
        if (env_name[i] == name) {
            return 1
        }
    }
    return 0
}

# State persistence implementation
function save_state() {
    debug("Saving state to: " STATE_FILE)
    for (i = 0; i < func_def_size; i++) {
        debug("Saving function: " func_def_names[i])
        print "FUNC " func_def_names[i] " " func_def_code[i] > STATE_FILE
    }
    close(STATE_FILE)

    # Save environment state
    debug("Saving environment state to: " ENV_STATE_FILE)
    for (i = 0; i < env_size; i++) {
        if (env_name[i] ~ /^__global_/) {  # Only save globals
            debug("Saving env var: " env_name[i] " = " env_val[i])
            print "ENV " env_name[i] " " env_val[i] > ENV_STATE_FILE
        }
    }
    close(ENV_STATE_FILE)
}

# Built-in function implementations
function equals() {
    if (stack_ptr < 2) error("= requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) error("= requires numeric operands")
    result = (getValue(val1) == getValue(val2)) ? 1 : 0
    push(makeValue(T_BOOLEAN, result))
}

function less_than() {
    if (stack_ptr < 2) error("< requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) error("< requires numeric operands")
    result = (getValue(val1) < getValue(val2)) ? 1 : 0
    push(makeValue(T_BOOLEAN, result))
}

function greater_than() {
    if (stack_ptr < 2) error("> requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) error("> requires numeric operands")
    result = (getValue(val1) > getValue(val2)) ? 1 : 0
    push(makeValue(T_BOOLEAN, result))
}

function add() {
    if (stack_ptr < 2) error("+ requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) error("+ requires numeric operands")
    result = getValue(val1) + getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function subtract() {
    if (stack_ptr < 2) error("- requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) error("- requires numeric operands")
    result = getValue(val1) - getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function multiply() {
    if (stack_ptr < 2) error("* requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) error("* requires numeric operands")
    result = getValue(val1) * getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function divide() {
    if (stack_ptr < 2) error("/ requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) error("/ requires numeric operands")
    if (getValue(val2) == 0) error("Division by zero")
    result = getValue(val1) / getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function add_one() {
    if (stack_ptr < 1) error("add1 requires one operand")
    val = pop()
    if (!isNumber(val)) error("add1 requires numeric operand")
    result = getValue(val) + 1
    push(makeValue(T_NUMBER, result))
}

# Get value from top of stack
function vm_get_value() {
    val = peek()
    if (isSymbol(val)) {
        name = getValue(val)
        # If it's a function name, just push the name directly
        if (name in FUNCTIONS) {
            push(name)
        } else {
            push(makeValue(T_SYMBOL, name))
        }
    }
}