/*
 * $Id: sym.c 23501 2007-12-05 15:13:21Z paultcochrane $
 *
 * sym.c
 *
 * Cola compiler for Parrot
 *
 * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
 *
 */

/*

=head1 NAME

languages/cola/sym.c

=head1 DESCRIPTION

Symbol and Abstract Syntax Tree management utils.

=head2 Functions

=cut

*/

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "cola.h"
#include "parser.h"

Symbol          *main_method;
Symbol          *global_namespace;
SymbolTable     *global_symbol_table;
Symbol          *current_namespace;
SymbolTable     *current_symbol_table;
Symbol          *namespace_stack;
SymbolTable     *const_str;

/* For saving scope between namespaces.
 * each push_namespace should start with scope 0, and
 * pop_namespace should restore scope of last namespace.
 */
int             scope_stack[1024];
int             last_scope = 0;
int             scope = 0;
int             method_block = 0;
int             primary_block = 0;
AST             *primary_block_stack[256];


/*

=head3 Routines for managing symbols, attributes and AST tree

=over 4

=cut

*/

/*

=item C<void assert(void * p)>

RT#48200: Not yet documented!!!

=cut

*/

void assert(void * p)
{
    if (p == NULL) {
        fprintf(stderr, "NULL pointer assertion.\n");
        abort();
    }
}

/*

=item C<unsigned int hash_str(const char * str)>

RT#48200: Not yet documented!!!

=cut

*/

unsigned int hash_str(const char * str)
{
    unsigned long key = 0;
    const char * s;
    for (s=str; *s; s++)
        key = key * 65599 + *s;
    return key;
}

/*

=item C<void init_symbol_tables()>

RT#48200: Not yet documented!!!

=cut

*/

void init_symbol_tables()
{
    /* The global namespace with no name */
    global_namespace = mk_namespace_symbol(new_symbol("__GLOBAL__"));
    current_namespace = global_namespace;
    current_namespace->table = global_symbol_table = new_symbol_table();
    current_symbol_table = global_symbol_table;
    push_namespace(global_namespace);
    const_str = new_symbol_table();
}

/*

=item C<SymbolTable * new_symbol_table()>

RT#48200: Not yet documented!!!

=cut

*/

SymbolTable * new_symbol_table()
{
    SymbolTable * tab = malloc(sizeof (SymbolTable));
    assert(tab);
    memset(tab, sizeof (SymbolTable), 0);
    tab->scope = 1;
    return tab;
}

/*

=item C<Symbol * new_symbol(const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * new_symbol(const char * name)
{
    Symbol * s = malloc(sizeof (Symbol));
    assert(s);
    s->kind = 0;
    s->name = str_dup(name);
    s->scope = scope;
    s->typename = NULL;
    s->type = NULL;
    s->is_lval = 1;
#if 0
    s->init_expr = NULL;
#endif
    s->table = NULL;
    s->literal = s->next = s->tnext = NULL;
    return s;
}

/*

=item C<Symbol * new_identifier_symbol(const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * new_identifier_symbol(const char * name)
{
    Symbol * s = new_symbol(name);
    s->kind = IDENTIFIER;
    return s;
}

/*

=item C<Symbol * new_literal_symbol(const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * new_literal_symbol(const char * name)
{
    Symbol * s = new_symbol(name);
    s->kind = LITERAL;
    return s;
}

/*

=item C<Symbol * new_type_symbol(const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * new_type_symbol(const char * name)
{
    Symbol * s = new_symbol(name);
    s->kind = TYPE;
    return s;
}

/*

=item C<Symbol * mk_namespace_symbol(Symbol * identifier)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * mk_namespace_symbol(Symbol * identifier)
{
    Symbol * s = identifier;
    s->kind = NAMESPACE;
    s->table = new_symbol_table();
    return s;
}

/*

=item C<Symbol * mk_class_symbol(Symbol * identifier)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * mk_class_symbol(Symbol * identifier)
{
    Type * t = store_type(identifier->name, 0);
#if 0
    printf("#new_class(%s)\n", identifier->name);
#endif
    t->kind = CLASS;
    t->sym->table = new_symbol_table();
    return t->sym;
}

/*

=item C<Symbol * mk_method_symbol(Symbol * rettype, const char * name, const char * sig)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * mk_method_symbol(Symbol * rettype, const char * name, const char * sig)
{
    Symbol * s = new_symbol(name);
    s->kind = METHOD;
    return s;
}

/*

=item C<Symbol * symbol_concat(Symbol * s1, Symbol * s2)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * symbol_concat(Symbol * s1, Symbol * s2)
{
    int len = strlen(s1->name) + strlen(s2->name) + 1;
    Symbol * s = new_symbol("");
    s->name = malloc(len);
    strcpy(s->name, s1->name);
    strcat(s->name, s2->name);
    return s;
}

/*

=item C<Symbol * symbol_join3(Symbol * s1, Symbol * s2, Symbol * s3)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * symbol_join3(Symbol * s1, Symbol * s2, Symbol * s3)
{
    int len = strlen(s1->name) + strlen(s2->name) + strlen(s3->name) + 1;
    Symbol * s = new_symbol("");
    s->kind = s1->kind;
    s->name = malloc(len);
    strcpy(s->name, s1->name);
    strcat(s->name, s2->name);
    strcat(s->name, s3->name);
    return s;
}

/*

=item C<Symbol * symbol_join4(Symbol * s1, Symbol * s2, Symbol * s3, Symbol * s4)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * symbol_join4(Symbol * s1, Symbol * s2, Symbol * s3, Symbol * s4)
{
    int len = strlen(s1->name) + strlen(s2->name) + strlen(s3->name) +
                strlen(s4->name) + 1;
    Symbol * s = new_symbol("");
    s->kind = s1->kind;
    s->name = malloc(len);
    strcpy(s->name, s1->name);
    strcat(s->name, s2->name);
    strcat(s->name, s3->name);
    strcat(s->name, s4->name);
    return s;
}

/*

=item C<AST * new_ast(enum ASTKIND kind, int asttype, AST * arg1, AST * arg2)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_ast(enum ASTKIND kind, int asttype, AST * arg1, AST * arg2)
{
    AST * ast = malloc(sizeof (AST));
    assert(ast);
    ast->start_label = ast->end_label = NULL;
    ast->kind = kind;
    ast->asttype = asttype;
    ast->type = NULL;
    ast->typename = NULL;
    ast->op = 0;
    ast->arg1 = arg1;
    ast->arg2 = arg2;
    ast->sym = NULL;
    ast->targ = NULL;
    ast->vars = NULL;
    ast->up = NULL;
    ast->next = NULL;
    memset(&ast->Attr, 0, sizeof (ast->Attr));
    if (arg1)
        arg1->up = ast;
    if (arg2)
        arg2->up = ast;
    return ast;
}

/*

=item C<void push(Node ** list, Node * p)>

RT#48200: Not yet documented!!!

=cut

*/

void push(Node ** list, Node * p)
{
    p->next = *list;
    *list = p;
}

/*

=item C<void tpush(Node ** list, Node * p)>

RT#48200: Not yet documented!!!

=cut

*/

void tpush(Node ** list, Node * p)
{
    p->tnext = *list;
    *list = p;
}

/*

=item C<void tunshift(Node ** list, Node * p)>

"push" onto opposite end of temp stack

=cut

*/

void tunshift(Node ** list, Node * p)
{
    Node * l = *list;
    if (l && l == p) {
        printf("Oops: Shifting node list onto itself!\n");
        abort();
    }
    if (l != NULL) {
        while (l->tnext)
            l = l->tnext;
        l->tnext = p;
    }
    else *list = p;
}

/*

=item C<Node * pop(Node ** list)>

Return the top symbol on the stack.

=cut

*/

Node * pop(Node ** list)
{
    Node * top;
    top = *list;
    if (*list)
        *list = (*list)->next;
    return top;
}

/*

=item C<Node * tpop(Node ** list)>

Return the top symbol on the tstack.

=cut

*/

Node * tpop(Node ** list)
{
    Node * top;
    top = *list;
    if (*list)
        *list = (*list)->tnext;
    return top;
}



/* Easy RT#48202, rewrite below to call above generic Node versions */

/*

=item C<void push_sym(Symbol ** list, Symbol * p)>

RT#48200: Not yet documented!!!

=cut

*/

void push_sym(Symbol ** list, Symbol * p)
{
    p->next = *list;
    *list = p;
}

/*

=item C<void tpush_sym(Symbol ** list, Symbol * p)>

RT#48200: Not yet documented!!!

=cut

*/

void tpush_sym(Symbol ** list, Symbol * p)
{
    p->tnext = *list;
    *list = p;
}

/*

=item C<void tunshift_sym(Symbol ** list, Symbol * p)>

"push" onto opposite end of temp stack

=cut

*/

void tunshift_sym(Symbol ** list, Symbol * p)
{
    Symbol * l = *list;
    if (l && l == p) {
        printf("Oops: Shifting symbol list onto itself!\n");
        abort();
    }
    if (l != NULL) {
        while (l->tnext) {
            l = l->tnext;
        }
        l->tnext = p;
    }
    else {
        *list = p;
    }
}

/*

=item C<Symbol * pop_sym(Symbol ** list)>

Return the top symbol on the stack.

=cut

*/

Symbol * pop_sym(Symbol ** list)
{
    Symbol * top;
    top = *list;
    if (*list)
        *list = (*list)->next;
    return top;
}

/*

=item C<Symbol * tpop_sym(Symbol ** list)>

Return the top symbol on the tstack.

=cut

*/

Symbol * tpop_sym(Symbol ** list)
{
    Symbol * top;
    top = *list;
    if (*list)
        *list = (*list)->tnext;
    return top;
}

/*

=item C<void push_namespace(Symbol * ns)>

Push namespace onto the stack and set active namespace to top of stack.

=cut

*/

void push_namespace(Symbol * ns)
{
#if 1
    printf("#push_namespace(%s)\n", ns->name);
#endif
    scope_stack[last_scope++] = scope;
    scope = 0;
    current_namespace = ns;
    current_symbol_table = current_namespace->table;
    tpush_sym(&namespace_stack, ns);
}

/*

=item C<Symbol * pop_namespace()>

Pop namespace off the stack and set active namespace to top of stack.
Leaves namespace symbol in symbol table.

=cut

*/

Symbol * pop_namespace()
{
    Symbol * ns;
    ns = tpop_sym(&namespace_stack);
    scope = scope_stack[--last_scope];
    if (last_scope < 0) {
        fprintf(stderr, "Internal error: scope unbalanced, popped scope 0\n");
        abort();
    }
    current_namespace = namespace_stack;
    current_symbol_table = current_namespace->table;
    return ns;
}

/*

=item C<void unshift_ast(AST ** list, AST * p)>

"push" onto opposite end of stack

=cut

*/

void unshift_ast(AST ** list, AST * p)
{
    AST * l = *list;
    if (l && l == p) {
        printf("Oops: Shifting ast list onto itself!\n");
        abort();
    }
    if (l != NULL) {
        while (l->next)
            l = l->next;
        l->next = p;
    }
    else *list = p;
}

/*

=item C<AST * new_statement(int stmnttype, AST * left, AST * right)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_statement(int stmnttype, AST * left, AST * right)
{
    AST * p = new_ast(KIND_STATEMENT, stmnttype, left, right);
    return p;
}

/*

=item C<AST * new_expr(int exprtype, AST * left, AST * right)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_expr(int exprtype, AST * left, AST * right)
{
    AST * p = new_ast(KIND_EXPR, exprtype, left, right);
    return p;
}

/*

=item C<AST * new_op_expr(AST * left, int op, AST * right)>

Specific type of expression (A b C) where b is an operator

=cut

*/

AST * new_op_expr(AST * left, int op, AST * right)
{
    AST * p = new_ast(KIND_EXPR, ASTT_OP, left, right);
    p->op = op;
    return p;
}

/*

=item C<AST * new_logical_expr(AST * left, int op, AST * right)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_logical_expr(AST * left, int op, AST * right)
{
    AST * p = new_ast(KIND_EXPR, ASTT_LOGICAL, left, right);
    p->op = op;
    return p;
}

/*

=item C<AST * new_if(AST * condition, AST * then_part, AST * else_part)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_if(AST * condition, AST * then_part, AST * else_part)
{
    AST * p = new_statement(ASTT_IF, then_part, else_part);
    p->Attr.Conditional.condition = condition;
    return p;
}

/*

=back

=head3 Ternary conditionals

=over 4

=cut

*/

/*

=item C<AST * new_conditional(AST * condition, AST * then_part, AST * else_part)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_conditional(AST * condition, AST * then_part, AST * else_part)
{
    AST * p = new_ast(KIND_EXPR, ASTT_CONDITIONAL_EXPR, then_part, else_part);
    p->Attr.Conditional.condition = condition;
    return p;
}

/*

=item C<AST * new_while(AST * condition, AST * block)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_while(AST * condition, AST * block)
{
    AST * p = new_statement(ASTT_WHILE, NULL, NULL);
    p->Attr.Loop.condition = condition;
    p->Attr.Loop.body = block;
    return p;
}

/*

=item C<AST * new_for(AST * init, AST * condition, AST * iteration, AST * block)>

RT#48200: Not yet documented!!!

=cut

*/

AST * new_for(AST * init, AST * condition, AST * iteration, AST * block)
{
    AST * p = new_statement(ASTT_FOR, NULL, NULL);
    p->Attr.Loop.init = init;
    p->Attr.Loop.condition = condition;
    p->Attr.Loop.iteration = iteration;
    p->Attr.Loop.body = block;
    return p;
}

/*

=item C<Symbol * split(const char * pattern, const char * s)>

Only using first char of pattern for now.

=cut

*/

Symbol * split(const char * pattern, const char * s)
{
    char c = pattern[0];
    Symbol * l = NULL;
    const char * p;
    int len;
    if (!strstr(s, pattern))
        return new_symbol(s);
    p = s;
AGAIN:
    for (len = 0; p[len] && p[len] != c; len++)
        ;
    if (len) {
        Symbol * n = new_symbol("");
        n->name = malloc(len+1);
        strncpy(n->name, p, len);
        n->name[len] = '\0';
        tunshift_sym(&l, n);
    }
    if (!len || !p[len])
        return l;
    else {
        len++;
        p += len;
        goto AGAIN;
    }
}

/*

=item C<Symbol * lookup_symbol(const char * name)>

Return first occurence of symbol in surrounding scopes.

=cut

*/

Symbol * lookup_symbol(const char * name)
{
    Symbol * ns = current_namespace;
    Symbol * list = split(".", name);
    Symbol * s;
#if DEBUG
    fprintf(stderr, "lookup_symbol: %s split to (%s,...)\n", name, list->name);
#endif
    for (ns = current_namespace; ns;) {
#if DEBUG
        fprintf(stderr, "lookup_symbol: searching namespace[%s] for [%s]\n", ns->name, list->name);
#endif
        if ((s = lookup_symbol_in_tab(ns->table, list->name))) {
#if DEBUG
            fprintf(stderr, "lookup_symbol: found [%s] in namespace[%s]\n", list->name, ns->name);
#endif
            if (s->kind == IDENTIFIER) {
                ns = s->type->sym;
            }
            else {
                ns = s;
            }
            list = list->tnext;
            if (!list || !s)
                return s;
        }
        else {
            ns = ns->tnext;
        }
    }

    return NULL;
}

/*

=item C<Symbol * lookup_symbol_in_tab(SymbolTable * tab, const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * lookup_symbol_in_tab(SymbolTable * tab, const char * name)
{
    Symbol * sym_ptr;
    unsigned int index = hash_str(name) % HASH_SIZE;
    if (!tab) {
        fprintf(stderr, "Internal error: NULL symbol table\n");
        fprintf(stderr, "while resolving [%s]\n", name);
        abort();
    }
    for (sym_ptr = tab->table[ index ]; sym_ptr; sym_ptr = sym_ptr->next)    {
        if (!strcmp(name, sym_ptr->name))
            return sym_ptr;
    }

    return NULL;
}

/*

=item C<Symbol * lookup_namespace(SymbolTable * tab, const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * lookup_namespace(SymbolTable * tab, const char * name)
{
    Symbol * sym_ptr;
    unsigned int index = hash_str(name) % HASH_SIZE;
    for (sym_ptr = tab->table[ index ]; sym_ptr; sym_ptr = sym_ptr->next)    {
        if (sym_ptr->kind == NAMESPACE && !strcmp(name, sym_ptr->name))
            return sym_ptr;
    }

    return NULL;
}

/*

=item C<Symbol * lookup_class(SymbolTable * tab, const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * lookup_class(SymbolTable * tab, const char * name)
{
    Symbol * sym_ptr;
    unsigned int index = hash_str(name) % HASH_SIZE;
    for (sym_ptr = tab->table[ index ]; sym_ptr; sym_ptr = sym_ptr->next)    {
        if (sym_ptr->kind == CLASS && !strcmp(name, sym_ptr->name))
            return sym_ptr;
    }

    return NULL;
}

/*

=item C<Symbol * lookup_symbol_scope(SymbolTable * tab, const char * name, int scope_level)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * lookup_symbol_scope(SymbolTable * tab, const char * name, int scope_level)
{
    Symbol * sym_ptr;
    unsigned int index = hash_str(name) % HASH_SIZE;
    for (sym_ptr = tab->table[ index ]; sym_ptr; sym_ptr = sym_ptr->next) {
        if (sym_ptr->scope == scope_level
            && !strcmp(name, sym_ptr->name))
            return sym_ptr;
    }

    return 0;
}

/*

=item C<Symbol * store_symbol(SymbolTable * tab, Symbol * sym)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * store_symbol(SymbolTable * tab, Symbol * sym)
{
    unsigned int index = hash_str(sym->name) % HASH_SIZE;
#if 0
    fprintf(stderr, "#store_symbol(%s)\n", sym->name);
    if (sym->table && sym->table == tab) {
        fprintf(stderr, "Internal error, namespace->symbol table loop.\n");
        fprintf(stderr, "Symbol [%s] contains loopback namespace.\n", sym->name);
        abort();
    } else if (sym == global_namespace) {
        fprintf(stderr, "Internal error, can't store global namespace.\n");
        abort();
    }
#endif
    sym->scope = scope;
    sym->next = tab->table[index];
    sym->namespace = current_namespace;
    tab->table[index] = sym;
#ifdef DEBUG
    fprintf(stderr, "storing[%s] scope %d\n", sym->name, scope);
#endif
    return sym;
}

/*
Symbol * store_identifier(SymbolTable * tab, const char * name) {
    Symbol * s;
    s = new_symbol(name);
    s->kind = IDENTIFIER;
    s->type = lookup_type_symbol(s->typename);
    s->scope = scope;
    store_symbol(tab, s);
    return s;
}
*/

/*

=item C<Symbol * store_method(SymbolTable * tab, const char * name, Type * type)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * store_method(SymbolTable * tab, const char * name, Type * type)
{
    Symbol * s;
    s = new_symbol(name);
    s->kind = METHOD;
    s->type = type;
    s->typename = type->sym;
    s->scope = scope;
    store_symbol(tab, s);
    return s;
}

/*

=item C<void declare_local(Symbol * s)>

Method locals

=cut

*/

void declare_local(Symbol * s)
{
    fprintf(stderr, "declare_local[%s]\n", s->name);
    store_symbol(current_symbol_table, s);
    if (s->typename) {
        s->type = lookup_type_symbol(s->typename);
        if (!s->type) {
            fprintf(stderr, "declare_local: NULL type for ident [%s] typename [%s]\n",
                s->name, s->typename->name);
            abort();
        }
    }
    else {
        fprintf(stderr, "declare_local: NULL typename for ident [%s]\n",
                s->name);
        abort();
    }
}

/*

=item C<void declare_field(Symbol * s)>

Class fields

=cut

*/

void declare_field(Symbol * s)
{
    fprintf(stderr, "declare_field[%s]\n", s->name);
    if (!current_namespace->type || current_namespace->type->kind != CLASS) {
        fprintf(stderr, "Internal Error: field declarations only valid for classes.\n");
        fprintf(stderr, "Current namespace is [%s]\n", current_namespace->name);
        abort();
    }

    store_symbol(current_symbol_table, s);
    if (s->typename) {
        s->type = lookup_type_symbol(s->typename);
        if (!s->type) {
            fprintf(stderr, "declare_local: NULL type for ident [%s] typename [%s]\n",
                s->name, s->typename->name);
            abort();
        }
    }
    else {
        fprintf(stderr, "declare_local: NULL typename for ident [%s]\n",
                s->name);
        abort();
    }
}

/*

=item C<void dump_namespace(Symbol * ns)>

RT#48200: Not yet documented!!!

=cut

*/

void dump_namespace(Symbol * ns)
{
    if (ns->kind == CLASS) {
        printf("#<class %s>\n", ns->name);
        if (ns->table)
            dump_symbol_table(ns->table);
        printf("#</class>\n");
    } else if (ns->kind == NAMESPACE) {
        printf("#<namespace %s>\n", ns->name);
        dump_symbol_table(ns->table);
        printf("#</namespace>\n");
    }
}

/*

=item C<void dump_symbol_table(SymbolTable * tab)>

RT#48200: Not yet documented!!!

=cut

*/

void dump_symbol_table(SymbolTable * tab)
{
    Symbol * sym;
    int i;
    printf("#  <symbol table>\n");
    for (i = 0; i < HASH_SIZE; i++) {
        for (sym = tab->table[i]; sym; sym = sym->next) {
            switch (sym->kind) {
                case CLASS:
                case NAMESPACE:
                            if (sym->table) {
                                if (sym->table == tab) {
                                    printf("Internal error, namespace->symbol table loop.\n");
                                    printf("Symbol [%s] contains loopback namespace.\n", sym->name);
                                    abort();
                                }
                                dump_namespace(sym);
                            }
                    break;
                case METHOD:
                            printf("#\tmethod:  \"%s\"\n", sym->name);
                    break;
                case IDENTIFIER:
                            printf("#\tid:      \"%s\"\n", sym->name);
                    break;
                case LITERAL:
                            printf("#\tliteral: \"%s\"\n", sym->name);
                    break;
                case TYPE:  printf("#\ttype:    \"%s\"\n", sym->name);
                            if (sym->table) {
                                if (sym->table == tab) {
                                    printf("Internal error, namespace->symbol table loop.\n");
                                    printf("Symbol [%s] contains loopback namespace.\n", sym->name);
                                    abort();
                                }
                                dump_namespace(sym);
                            }
                    break;
                default:    printf("#\tunknown:   \"%s\"\n", sym->name);
                    break;
            }
        }
    }
    printf("#  </symbol table>\n");
}

/*

=item C<Symbol * check_id_redecl(SymbolTable * table, const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * check_id_redecl(SymbolTable * table, const char * name)
{
    Symbol * t;
    if ((t = lookup_symbol_scope(table, name, scope)) != NULL) {
        printf("error (line %ld): identifier %s previously declared in this scope, line %d.\n", line, name, t->line);
        abort();
        exit(EXIT_SUCCESS);
    }
    return t;
}

/*

=item C<Symbol * check_id_decl(SymbolTable * table, const char * name)>

RT#48200: Not yet documented!!!

=cut

*/

Symbol * check_id_decl(SymbolTable * table, const char * name)
{
    Symbol * t;
    if ((t = lookup_symbol_in_tab(table, name)) == NULL)
        return NULL;
    return t;
}

/*

=item C<int push_scope()>

RT#48200: Not yet documented!!!

=cut

*/

int push_scope()
{
    scope++;
    return scope;
}

/*

=item C<Symbol * pop_scope()>

Pop current scope level and return a list of
symbols if symbol table is passed.

=cut

*/

Symbol * pop_scope()
{
    int i;
    SymbolTable * tab = current_symbol_table;
    Symbol * p = NULL;
    for (i = 0; i < HASH_SIZE; i++) {
        while (tab->table[i] && tab->table[i]->scope == scope) {
            Symbol * t;
#if DEBUG
            printf("popping symbol %s: level %d\n", tab->table[i]->name, scope);
#endif
            t = tab->table[i];
            tab->table[i] = tab->table[i]->next;
            t->tnext = p;
            t->next = NULL;
            p = t;
        }
    }

    if (scope > 0)
        scope--;
    else {
        fprintf(stderr, "Internal error: can't pop scope 0.\n");
        abort();
    }

    return p;
}

/*

=item C<void discard_scope()>

Same as pop_scope except no list is built and returned.
This is for cases where a list already existed, and each
node was inserted into the symbol table, and we want to
preserve that external list, so we can't scribble on the
->tnext pointer as it may reorder the list or invalidate it.

=cut

*/

void discard_scope()
{
    int i;
    SymbolTable * tab = current_symbol_table;
    for (i = 0; i < HASH_SIZE; i++) {
        while (tab->table[i] && tab->table[i]->scope == scope) {
            Symbol * t;
#ifdef DEBUG
            printf("discarding symbol %s: level %d\n", tab->table[i]->name, scope);
#endif
            t = tab->table[i];
            tab->table[i] = tab->table[i]->next;
            t->next = NULL;
        }
    }

    if (scope > 0)
        scope--;
    else {
        fprintf(stderr, "Internal error: can't discard scope 0.\n");
        abort();
    }
}

/*

=item C<void push_primary_block(AST * p)>

Don't laugh, this little array based stack is so I don't
have to add a 3rd ->next pointer to the AST struct.
It also means my design is wrong, will fix after adding
brain expansion pack.

=cut

*/

void push_primary_block(AST * p)
{
    primary_block_stack[primary_block++] = p;
}

/*

=item C<AST * pop_primary_block()>

RT#48200: Not yet documented!!!

=cut

*/

AST * pop_primary_block()
{
    if (primary_block > 0)
        return primary_block_stack[--primary_block];
    return NULL;
}

/*

=item C<AST * get_cur_primary_block()>

RT#48200: Not yet documented!!!

=cut

*/

AST * get_cur_primary_block()
{
    if (primary_block > 0)
        return primary_block_stack[primary_block-1];
    return NULL;
}

/*

=item C<char * str_dup(const char * old)>

RT#48200: Not yet documented!!!

=cut

*/

char * str_dup(const char * old)
{
    char * copy = (char *)malloc(strlen(old) + 1);
    strcpy(copy, old);
    return copy;
}

/*

=item C<char * str_cat(const char * s1, const char * s2)>

RT#48200: Not yet documented!!!

=cut

*/

char * str_cat(const char * s1, const char * s2)
{
    int len = strlen(s1) + strlen(s2) + 1;
    char * s3 = malloc(len);
    strcpy(s3, s1);
    strcat(s3, s2);
    return s3;
}

/*

=back

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */