/* Returns the value associated with name, depends on if the logo_object is
* included in the hierarchy or not.
*/
NODE *varInObjectHierarchy(NODE *name, BOOLEAN includeLogo) {
NODE *result, *parentList;
result = assoc(name, getvars(current_object));
if (result != NIL) {
return getobject(result);
}
for (parentList = parent_list(current_object);
parentList != NIL;
parentList = cdr(parentList)) {
result = assoc(name, getvars(car(parentList)));
if (result != NIL) {
return getobject(result);
}
}
if (!includeLogo) {
return (NODE *)(-1);
}
result = intern(name);
if (flag__caseobj(result, IS_LOCAL_VALUE)) {
return (NODE *)(-1);
}
return valnode__caseobj(result);
}
/* Initializes Object Logo */
void obj_init(void) {
logo_object = newobj();
current_object = logo_object;
setvars(logo_object, cons(theName(Name_name), getvars(logo_object)));
setobject(getvars(logo_object), make_static_strnode("Logo"));
/* [[initlist] [exist output self]] */
askexist = cons(cons(theName(Name_initlist), NIL),
cons(cons(theName(Name_exist),
cons(theName(Name_output),
cons(theName(Name_self), NIL))),
NIL));
}
/* Returns the object which contains the name, depends on if the
* logo_object is included in the hierarchy or not.
*/
NODE *varInThisObject(NODE *name, BOOLEAN includeLogo) {
NODE *object, *result, *parentList;
result = assoc(name, getvars(current_object));
if (result != NIL) return current_object;
for (parentList = parent_list(current_object);
parentList != NIL && result == NIL;
parentList = cdr(parentList)) {
result = assoc(name, getvars(car(parentList)));
object = car(parentList);
if (result != NIL) return object;
}
if (!includeLogo) return NIL;
result = intern(name);
if (flag__caseobj(result, IS_LOCAL_VALUE)) return NIL;
return logo_object;
}
/* representation of an object */
NODE *lrepresentation(NODE *args) {
NODE *license, *binding, *classbind;
char buffer[200];
char *old_stringptr = print_stringptr;
int old_stringlen = print_stringlen;
print_stringlen = 200;
print_stringptr = buffer;
license = assoc(theName(Name_licenseplate), getvars(current_object));
ndprintf(NULL, "${Object %p", getobject(license));
binding = assoc(theName(Name_name), getvars(current_object));
if (binding != NIL && getobject(binding) != UNBOUND) {
ndprintf(NULL, ": %p", getobject(binding));
}
classbind = assoc(theName(Name_class), getvars(current_object));
if (classbind != NIL) {
if (binding == NIL || getobject(binding) == UNBOUND) {
ndprintf(NULL, ":");
}else {
ndprintf(NULL, ",");
}
ndprintf(NULL, " the class %p", getobject(classbind));
} else {
classbind = varInObjectHierarchy(theName(Name_class), FALSE);
if (classbind != UNBOUND && classbind != (NODE *)(-1)) {
if (binding == NIL) {
ndprintf(NULL, ":");
} else {
ndprintf(NULL, ",");
}
ndprintf(NULL, " a %p", classbind);
}
}
ndprintf(NULL, "}");
print_stringptr* = '\0';
print_stringptr = old_stringptr;
print_stringlen = old_stringlen;
return make_strnode(buffer, NULL, strlen(buffer), STRING, strnzcpy);
}
/* Creates the object variable named Symbol, or the object variables named ,
* SymbolList within the current object.
* @params - Symbol or SymbolList
*/
NODE *lhave(NODE *args) {
if (is_list(car(args))) {
if (cdr(args) != NIL) {
err_logo(TOO_MUCH, NIL); /* too many inputs */
}
args = car(args);
}
/* now args is always a list of symbols. args should not equal to NIL
because that is checked for before. */
while (args != NIL && NOT_THROWING) {
NODE *sym = intern(car(args));
NODE *binding = assoc(sym, getvars(current_object));
if (binding == NIL) {
setvars(current_object, cons(sym, getvars(current_object)));
setobject(getvars(current_object), UNBOUND);
}
args = cdr(args);
}
return UNBOUND;
}
static struct vars *
argvars(lua_State *L, int onlyfetch) {
static int args = 0;
if (onlyfetch) {
lua_rawgetp(L, LUA_REGISTRYINDEX, &args);
if (lua_isuserdata(L, -1)) {
struct vars ** box = (struct vars **)lua_touserdata(L, -1);
lua_pop(L,1);
return *box;
} else {
lua_pop(L,1);
return NULL;
}
} else {
return getvars(L, &args);
}
}
/* Outputs TRUE if Symbol is the name of an object variable owned by the
* current object, FALSE otherwise.
* @params - Symbol
*/
NODE *lmynamep(NODE *args) {
NODE *arg;
arg = name_arg(args);
if (NOT_THROWING) {
arg = intern(arg);
if (current_object == logo_object) {
return torf(flag__caseobj(arg, HAS_GLOBAL_VALUE));
}
else
return torf(assoc(arg, getvars(current_object)) != NIL);
}
return UNBOUND;
}
static struct vars *
resultvars(lua_State *L) {
static int result = 0;
return getvars(L, &result);
}
/* Outputs a list of the names of the object variables owned by (not
* inherited by) the current object.
* @params - none
*/
NODE *lmynames(NODE *args) {
return getvars(current_object);
}
