def.c

Go to the documentation of this file.

#include "tree.h"
#include "stream.h"
#include "def.h"
#include "semtrex.h"
char __d_extra_buf[100];

int semeq(SemanticID s1,SemanticID s2) {
    return (s1.context == s2.context)&&(s1.semtype == s2.semtype)&&(s1.id==s2.id);
    //    return (memcmp(&s1,&s2,sizeof(SemanticID))==0);
}

// used to find the semantic address for a def when building a SemanticID
// the semantic address is just the child index of the definition
SemanticAddr  _d_get_def_addr(T *def) {
    return _t_node_index(def);
}

SemanticID _d_define(SemTable *sem,T *def,SemanticType semtype,Context c) {
    T *definitions = __sem_get_defs(sem,semtype,c);
    _t_add(definitions,def);
    SemanticID sid = {c,semtype,_d_get_def_addr(def)};
    return sid;
}

// internal check to see if a symbol is valid
void __d_validate_symbol(SemTable *sem,Symbol s,char *n) {
    if (!is_symbol(s)) raise_error("Bad symbol in %s def: semantic type not SEM_TYPE_SYMBOL",n);
    if (is_sys_symbol(s) && (s.id == 0)) return; // NULL_SYMBOL ok
    T *symbols = _sem_get_defs(sem,s);
    if (!_t_child(symbols,s.id)) raise_error("Bad symbol in %s def: definition not found in context",n);
}

// internal check to see if a structure is valid
void __d_validate_structure(SemTable *sem,Structure s,char *n) {
    if (!is_structure(s)) raise_error("Bad structure in %s def: semantic type not SEM_TYPE_STRUCTURE",n);
    if (is_sys_structure(s) && (s.id == 0)) return; // NULL_STRUCTURE ok
    T *structures = _sem_get_defs(sem,s);
    if(s.id && !_t_child(structures,s.id)) {raise_error("Unknown structure <%d.%d.%d> in declaration of %s",s.context,s.semtype,s.id,n);}
}

// this is used to reset the structure of a symbol that has been pre declared as NULL_SYMBOL
// to it's actual value.
void __d_set_symbol_structure(T *symbols,Symbol sym,Structure s) {
    T *t = _t_child(symbols,sym.id);
    if (!t) raise_error("def not found!");
    T * structure_def = _t_child(t,SymbolDefStructureIdx);
    if (!semeq(NULL_STRUCTURE,*(Symbol *)_t_surface(structure_def)))
        raise_error("Symbol already defined");
    *(Symbol *)_t_surface(structure_def) = s;
}

// this is used to set the structure definition of a declared but undefined strcture
void __d_set_structure_def(T *structures,Structure s,T *def) {
    T *d = _t_child(structures,s.id);
    if (_t_children(d) > 1) raise_error("Structure already defined");
    _t_add(d,def);
}

Symbol _d_define_symbol(SemTable *sem,Structure s,char *label,Context c){
    __d_validate_structure(sem,s,label);
    T *def = _t_new_root(SYMBOL_DEFINITION);
    T *l = _t_newr(def,SYMBOL_LABEL);
    _t_new_str(l,ENGLISH_LABEL,label);
    _t_news(def,SYMBOL_STRUCTURE,s);

    return _d_define(sem,def,SEM_TYPE_SYMBOL,c);
}

Structure _d_define_structure(SemTable *sem,char *label,T *structure_def,Context c) {
    T *def = _t_new_root(STRUCTURE_DEFINITION);
    T *l = _t_newr(def,STRUCTURE_LABEL);
    _t_new_str(l,ENGLISH_LABEL,label);
    if (structure_def) _t_add(def,structure_def);
    return _d_define(sem,def,SEM_TYPE_STRUCTURE,c);
}

Structure _d_define_structure_v(SemTable *sem,char *label,Context c,int num_params,...) {
    va_list params;
    va_start(params,num_params);
    T *def = _d_make_vstruc_def(sem,label,num_params,params);
    va_end(params);
    return _d_define_structure(sem,label,def,c);
}

// build a STRUCTURE_SEQUENCE STRUCTURE_DEF out of va_list
T * _d_make_vstruc_def(SemTable *sem,char *label,int num_params,va_list params) {
    T *p,*seq = 0;
    if (num_params > 1)
        seq = _t_newr(0,STRUCTURE_SEQUENCE);
    int i;
    for(i=0;i<num_params;i++) {
        Symbol s = va_arg(params,Symbol);
        __d_validate_symbol(sem,s,label);
        p = _t_news(seq,STRUCTURE_SYMBOL,s);
    }
    return seq ? seq : p;
}

Structure __d_get_symbol_structure(T *symbols,Symbol s) {
    T *def = _t_child(symbols,s.id);
    if (!def) {
        raise_error("Bad symbol:%d.%d.%d-- only %d symbols in decl list",s.context,s.semtype,s.id,_t_children(symbols));
    }
    T *t = _t_child(def,SymbolDefStructureIdx);
    return *(Structure *)_t_surface(t);
}



size_t _d_get_symbol_size(SemTable *sem,Symbol s,void *surface) {
    Structure st = _sem_get_symbol_structure(sem,s);
    return _d_get_structure_size(sem,st,surface);
}

size_t _sys_structure_size(int id,void *surface) {
    switch(id) {
    case TREE_ID:
    case NULL_STRUCTURE_ID: return 0;
        //      case SEMTREX: return
    case PROCESS_ID:
    case PROTOCOL_ID:
    case STRUCTURE_ID:
    case SYMBOL_ID: return sizeof(SemanticID);
    case BIT_ID:
    case INTEGER_ID: return sizeof(int);
    case INTEGER64_ID: return sizeof(uint64_t);
    case FLOAT_ID: return sizeof(float);
    case CSTRING_ID: return strlen(surface)+1;
    case XADDR_ID: return sizeof(Xaddr);
    case UUID_ID: return sizeof(UUIDt);
    case CPOINTER_ID:
    case RECEPTOR_ID:
    case SCAPE_ID:
        return sizeof(void *);
    default: return -1;
    }
}

size_t _d_get_structure_size(SemTable *sem,Structure s,void *surface) {
    size_t size = 0;
    T *structures = _sem_get_defs(sem,s);

    if (is_sys_structure(s)) {
        size = _sys_structure_size(s.id,surface);
        if (size == -1) {
            raise_error("DON'T HAVE A SIZE FOR STRUCTURE '%s' (%d)",_sem_get_name(sem,s),s.id);
        }
    }
    else {
        T *structure = _t_child(structures,s.id);
        T *parts = _t_child(structure,2);
        if (semeq(_t_symbol(parts),STRUCTURE_SEQUENCE)) {
            DO_KIDS(parts,
                    T *p = _t_child(parts,i);
                    if (!semeq(_t_symbol(p),STRUCTURE_SYMBOL)) {
                        raise_error("CAN'T GET SIZE FOR VARIABLE STRUCTURES '%s' (%d)",_sem_get_name(sem,s),s.id);
                    }
                    size += _d_get_symbol_size(sem,*(Symbol *)_t_surface(p),surface +size);
                    );
        }
        else if (semeq(_t_symbol(parts),STRUCTURE_SYMBOL)) {
            size = _d_get_symbol_size(sem,*(Symbol *)_t_surface(parts),surface);
        }
    }
    return size;
}

#define MAX_HASHES 10
// extract the template signature from the code
void __d_tsig(SemTable *sem,T *code, T *tsig,TreeHash *hashes) {
    Symbol sym = _t_symbol(code);

    // hack to get around falsely adding a TEMPLATE_SIGNATURE see bug #127
    if (semeq(sym,FILL_FROM_MATCH)) return;
    if (semeq(sym,SLOT)) {
        TreeHash h;
        T *c = NULL;
        // slot children aren't part of the signature they are part of the
        // the code that needs to be searched!
        if (c = _t_find(code,SLOT_CHILDREN)) {
            int i = _t_node_index(c);
            c = _t_clone(code);
            T *sc = _t_detach_by_idx(c,i);
            __d_tsig(sem,sc,tsig,hashes);
            _t_free(sc);
            _t_hash(sem,c);
        }
        else h = _t_hash(sem,code);
        // check for duplicates
        int i=0;
        while(hashes[i] && hashes[i]!=h) {
            i++;
            if (i == MAX_HASHES) raise_error("whoa! too many slots in code template");
        }
        // if its unique then add it.
        if (!hashes[i]) {
            hashes[i] = h;
            if (!c) c = _t_clone(code); // clone it if it wasn't cloned above
            c->contents.symbol = EXPECTED_SLOT;
            _t_add(tsig,c);
            c = NULL;
        }
        if (c) _t_free(c);
    }
    else {
        DO_KIDS(code,__d_tsig(sem,_t_child(code,i),tsig,hashes));
    }
}

T *_d_make_process_def(T *code,char *name,char *intention,T *signature,T *link) {
    T *def = _t_new_root(PROCESS_DEFINITION);
    T *l = _t_newr(def,PROCESS_NAME);
    _t_new_str(l,ENGLISH_LABEL,name);
    _t_new(def,PROCESS_INTENTION,intention,strlen(intention)+1);
    if (!code)
        code = _t_new_root(NULL_PROCESS); // indicates a system (i.e. non ceptr) defined process
    _t_add(def,code);
    if (!signature) {
        // @todo, we really shouldn't be doing this, but have to for now...
        signature = _t_new_root(PROCESS_SIGNATURE);
    }
    _t_add(def,signature);
    if (link) {
        _t_add(def,link);
    }
    return def;
}


Process _d_define_process(SemTable *sem,T *code,char *name,char *intention,T *signature,T *link,Context c) {
    T *def = _d_make_process_def(code,name,intention,signature,link);
    if (signature && code) {
        T *tsig = _t_new_root(TEMPLATE_SIGNATURE);
        TreeHash h[MAX_HASHES]={0,0,0,0,0,0,0,0,0,0};
        __d_tsig(sem,code,tsig,h);
        if (_t_children(tsig)) _t_add(signature,tsig);
        else _t_free(tsig);
    }
    return _d_define(sem,def,SEM_TYPE_PROCESS,c);
}

Protocol _d_define_protocol(SemTable *sem,T *def,Context c) {
    //__d_validate_protocol(sem,def); //@todo
    return _d_define(sem,def,SEM_TYPE_PROTOCOL,c);
}

T *__d_build_def_semtrex(SemTable *sem,T *def,T *stx) {
    Symbol def_sym = _t_symbol(def);
    if (semeq(def_sym,STRUCTURE_SYMBOL)) {
        Symbol sym = *(Symbol *)_t_surface(def);
        if (!semeq(NULL_SYMBOL,sym))
            stx = _d_build_def_semtrex(sem,sym,stx);
    }
    else if (semeq(def_sym,STRUCTURE_SEQUENCE)) {
        int i,c = _t_children(def);
        if (c > 0) {
            stx = _t_newr(stx,SEMTREX_SEQUENCE);
            for(i=1;i<=c;i++) {
                __d_build_def_semtrex(sem,_t_child(def,i),stx);
            }
        }
    }
    else if (semeq(def_sym,STRUCTURE_OR)) {
        int i,c = _t_children(def);
        if (c == 1) {
            stx = _t_newr(stx,SEMTREX_ZERO_OR_ONE);
            __d_build_def_semtrex(sem,_t_child(def,1),stx);
        }
        else if (c > 1) {
            // semtrex OR is binary whereas structure def or is a set,
            // so we have to build up a binary tree OR structure
            // so, we build it up from the bottom first, building from the
            // last child backwards.
            T *last = __d_build_def_semtrex(sem,_t_child(def,c),NULL);
            for(i=c-1;i>=1;i--) {
                T *or = _t_new_root(SEMTREX_OR);
                __d_build_def_semtrex(sem,_t_child(def,i),or);
                _t_add(or,last);
                last = or;
            }
            if (stx) _t_add(stx,last);
            stx = last;
        }
    }
    else if (semeq(def_sym,STRUCTURE_ANYTHING)) {
        stx = _t_newr(stx,SEMTREX_ZERO_OR_MORE);
        stx = _t_newr(stx,SEMTREX_SYMBOL_ANY);
        if (_t_children(def))
            __d_build_def_semtrex(sem,_t_child(def,1),stx);
    }
    else if (semeq(def_sym,STRUCTURE_ZERO_OR_MORE)) {
        stx = _t_newr(stx,SEMTREX_ZERO_OR_MORE);
        __d_build_def_semtrex(sem,_t_child(def,1),stx);
    }
    else if (semeq(def_sym,STRUCTURE_ONE_OR_MORE)) {
        stx = _t_newr(stx,SEMTREX_ONE_OR_MORE);
        __d_build_def_semtrex(sem,_t_child(def,1),stx);
    }
    else {
        raise_error("translation from %s not implemented\n",_sem_get_name(sem,def_sym));
    }
    return stx;
}

T * _d_build_def_semtrex(SemTable *sem,Symbol s,T *parent) {
    T *stx = _sl(parent,s);

    //printf("building semtrex for %s\n",_sem_get_name(sem,s));
    Structure st = _sem_get_symbol_structure(sem,s);
    if (!semeq(st,NULL_STRUCTURE)) {
        T *structure = _sem_get_def(sem,st);
        T *def = _t_child(structure,StructureDefDefIdx);
        __d_build_def_semtrex(sem,def,stx);
    }
    return stx;
}

SemanticID _d_define_receptor(SemTable *sem,char *label,T *definitions,Context c) {

    T *def = _t_new_root(RECEPTOR_DEFINITION);
    T *l=_t_newr(def,RECEPTOR_LABEL);
    _t_new_str(l,ENGLISH_LABEL,label);
    _t_add(def,definitions);

    return __d_define_receptor(sem,def,c);
}

SemanticID __d_define_receptor(SemTable *sem,T *def,Context c) {

    T *definitions = _t_child(def,ReceptorDefinitionDefsIdx);

    bool vmhost_special_case = (c == SYS_CONTEXT) && (!sem->contexts);
    //__d_validate_receptor(sem,def); //@todo
    // @todo recursively add definitions for any receptors defined in def
    if (_t_children(_t_child(definitions,SEM_TYPE_RECEPTOR))) {
        raise_error("recursive receptor definition not yet implemented");
    }
    Context new_context = _sem_new_context(sem,definitions);

    // big trick!! put the context number in the surface of the definition so
    // we can get later in _d_get_receptor_address
    (*(int *)_t_surface(def)) = new_context;

    // account for the one exception where the VMHost is defined inside itself
    // we can't use _d_define because when it tries to look up the newly added
    // def with _d_get_def_addr which uses _t_get_path, it will fail on the infinite loop.
    if (vmhost_special_case) {
        // this makes the "defined-inside-itself" loop!
        //        _t_add(def,d);
        SemanticID sid = {c,SEM_TYPE_RECEPTOR,0};
        return sid;
    }
    return _d_define(sem,def,SEM_TYPE_RECEPTOR,c);
}

// this works because when a receptor gets defined the semantic context get jammed into the definition surface!
Context _d_get_receptor_context(SemTable *sem,SemanticID r) {
    T *def = _sem_get_def(sem,r);
    return *(int *)_t_surface(def);
}

/*****************  Tree debugging utilities */

char * __t2s(SemTable *sem,T *t,int indent) {
    static char buf[100000];
    buf[0] = 0;
    return __t_dump(sem,t,indent,buf);
}

char *_indent_line(int level,char *buf) {
    if (level < -1) {
        int j = (-level - 1)*3;
        *buf++ = '\n';
        while(j--) *buf++ = ' ';
        *buf = 0;
    }
    else if (level > 0) {
        *buf++ = ' ';
    }
    return buf;
}

#include "ansicolor.h"
#define MAX_LEVEL 100
T *G_cursor = NULL;
char * __t_dump(SemTable *sem,T *t,int level,char *buf) {
    if (!t) return "";
    Symbol s = _t_symbol(t);
    char b[255];
    char tbuf[2000];
    int i;
    char *c,*obuf;
    Xaddr x;
    buf = _indent_line(level,buf);

    if (level > MAX_LEVEL) {
        raise_error("whoa, MAX_LEVEL exceeded!");
    }

    // use this to mark all run nodes with a %
    /* if (t->context.flags & TFLAG_RUN_NODE) { */
    /*     *buf++ = '%'; */
    /*     sprintf(buf,"%d",rt_cur_child(t)); */
    /*     buf += strlen(buf); */
    /* } */

    char *n = _sem_get_name(sem,s);
    obuf = buf;
    if (t && (t == G_cursor)) {sprintf(buf,KRED);buf += strlen(buf);}

    if (is_process(s)) {
        sprintf(buf,"(process:%s",n);
    }
    else if (is_receptor(s)) {
        if (t->context.flags & (TFLAG_SURFACE_IS_TREE+TFLAG_SURFACE_IS_RECEPTOR)) {
            c = __t_dump(sem,((Receptor *)_t_surface(t))->root,0,tbuf);
            sprintf(buf,"(%s:{%s}",n,c);
        }
        else {
            raise_error("bad node flags for receptor semtype!");
        }
    }
    else if (semeq(s,NULL_SYMBOL)) {
        sprintf(buf,"(NULL_SYMBOL");
    }
    else {
        Structure st = _sem_get_symbol_structure(sem,s);
        if (!is_sys_structure(st)) {
            // if it's not a system structure, it's composed, so all we need to do is
            // print out the symbol name, and the reset will take care of itself
            sprintf(buf,"(%s",n);
        }
        else {
            switch(st.id) {
            case ENUM_ID: // for now enum surfaces are just strings so we can see the text value
            case CSTRING_ID:
                sprintf(buf,"(%s:%s",n,(char *)_t_surface(t));
                break;
            case BLOB_ID:
                sprintf(buf,"(%s:%ld-byte-blob",n,_t_size(t));
                break;
            case CHAR_ID:
                sprintf(buf,"(%s:'%c'",n,*(char *)_t_surface(t));
                break;
            case BIT_ID:
            case INTEGER_ID:
                sprintf(buf,"(%s:%d",n,*(int *)_t_surface(t));
                break;
            case INTEGER64_ID:
                sprintf(buf,"(%s:%ld",n,*(uint64_t *)_t_surface(t));
                break;
            case FLOAT_ID:
                sprintf(buf,"(%s:%f",n,*(float *)_t_surface(t));
                break;
            case SYMBOL_ID:
            case STRUCTURE_ID:
            case PROCESS_ID:
            case PROTOCOL_ID:
            case RECEPTOR_ID:
                c = _sem_get_name(sem,*(SemanticID *)_t_surface(t));
                sprintf(buf,"(%s:%s",n,c?c:"<unknown>");
                break;
            case TREE_PATH_ID:
                sprintf(buf,"(%s:%s",n,_t_sprint_path((int *)_t_surface(t),b));
                break;
            case XADDR_ID:
                x = *(Xaddr *)_t_surface(t);
                sprintf(buf,"(%s:%s.%d",n,_sem_get_name(sem,x.symbol),x.addr);
                break;
            /* case CPOINTER_ID: */
            /*     sprintf(buf,"(%s:%p",n,_t_surface(t)); */
            /*     break; */
            /* case UUID_ID: */
            /*     { */
            /*         UUIDt x = *(UUIDt *)_t_surface(t); */
            /*         sprintf(buf,"%s:%ld.%ld",n,x.data,x.time); */
            /*     } */
            /*     break; */
            case TREE_ID:
                if (t->context.flags & TFLAG_SURFACE_IS_TREE) {
                    c = __t_dump(sem,(T *)_t_surface(t),0,tbuf);
                    sprintf(buf,"(%s:{%s}",n,c);
                    break;
                }
                raise_error("TREE struct without TREE node flags");
            case RECEPTOR_SURFACE_ID:
                raise_error("boink bad receptor struct");
            case SCAPE_ID:
                if (t->context.flags & TFLAG_SURFACE_IS_SCAPE) {
                    Scape *sc = (Scape *)_t_surface(t);
                    sprintf(buf,"(%s:key %s,data %s",n,_sem_get_name(sem,sc->key_source),_sem_get_name(sem,sc->data_source));
                    break;
                }
            default:
                if (semeq(s,SEMTREX_MATCH_CURSOR)) {
                    c = __t_dump(sem,*(T **)_t_surface(t),0,tbuf);
                    //c = "null";
                    sprintf(buf,"(%s:{%s}",n,c);
                    break;
                }
                if (n == 0)
                    sprintf(buf,"(<unknown:%d.%d.%d>",s.context,s.semtype,s.id);
                else
                    sprintf(buf,"(%s",n);
            }
        }
    }
    if (t&&(t == G_cursor)) {sprintf(buf+strlen(buf),KNRM);}

    DO_KIDS(t,__t_dump(sem,_t_child(t,i),level < 0 ? level-1 : level+1,buf+strlen(buf)));
    sprintf(buf+strlen(buf),")");
    return obuf;
}