SOL_API bool
sol_json_scanner_next(struct sol_json_scanner *scanner, struct sol_json_token *token)
{
token->start = NULL;
token->end = NULL;
for (; scanner->current < scanner->mem_end; scanner->current++) {
enum sol_json_type type = sol_json_mem_get_type(scanner->current);
switch (type) {
case SOL_JSON_TYPE_UNKNOWN:
if (!isspace((uint8_t)scanner->current[0])) {
SOL_ERR("%zu: unexpected symbol %#x (%c)",
sol_json_scanner_get_mem_offset(scanner, scanner->current),
scanner->current[0], scanner->current[0]);
errno = EINVAL;
return false;
}
break;
case SOL_JSON_TYPE_OBJECT_START:
case SOL_JSON_TYPE_OBJECT_END:
case SOL_JSON_TYPE_ARRAY_START:
case SOL_JSON_TYPE_ARRAY_END:
case SOL_JSON_TYPE_ELEMENT_SEP:
case SOL_JSON_TYPE_PAIR_SEP:
token->start = scanner->current;
token->end = scanner->current + 1;
scanner->current = token->end;
return true;
case SOL_JSON_TYPE_TRUE:
return check_symbol(scanner, token, "true", sizeof("true") - 1);
case SOL_JSON_TYPE_FALSE:
return check_symbol(scanner, token, "false", sizeof("false") - 1);
case SOL_JSON_TYPE_NULL:
return check_symbol(scanner, token, "null", sizeof("null") - 1);
case SOL_JSON_TYPE_STRING:
return check_string(scanner, token);
case SOL_JSON_TYPE_NUMBER:
return check_number(scanner, token);
}
}
errno = 0;
return false;
}
JSList *
jack_internals_load (JSList * internals) {
char * driver_dir;
char driver_dir_storage[512];
char dll_filename[512];
WIN32_FIND_DATA filedata;
HANDLE file;
const char * ptr = NULL;
JSList * driver_list = NULL;
jack_driver_desc_t * desc;
if ((driver_dir = getenv("JACK_DRIVER_DIR")) == 0) {
// for WIN32 ADDON_DIR is defined in JackConstants.h as relative path
GetCurrentDirectory(512, driver_dir_storage);
strcat(driver_dir_storage, "/");
strcat(driver_dir_storage, ADDON_DIR);
driver_dir = driver_dir_storage;
}
sprintf(dll_filename, "%s/*.dll", driver_dir);
file = (HANDLE )FindFirstFile(dll_filename, &filedata);
if (file == INVALID_HANDLE_VALUE) {
jack_error("error");
return NULL;
}
do {
ptr = strrchr (filedata.cFileName, '.');
if (!ptr) {
continue;
}
ptr++;
if (strncmp ("dll", ptr, 3) != 0) {
continue;
}
/* check if dll is an internal client */
if (!check_symbol(filedata.cFileName, "jack_internal_initialize")) {
continue;
}
desc = jack_get_descriptor (internals, filedata.cFileName, "jack_get_descriptor");
if (desc) {
driver_list = jack_slist_append (driver_list, desc);
} else {
jack_error ("jack_get_descriptor returns null for \'%s\'", filedata.cFileName);
}
} while (FindNextFile(file, &filedata));
if (!driver_list) {
jack_error ("could not find any internals in %s!", driver_dir);
return NULL;
}
return driver_list;
}
JSList *
jack_internals_load (JSList * internals) {
struct dirent * dir_entry;
DIR * dir_stream;
const char * ptr;
int err;
JSList * driver_list = NULL;
jack_driver_desc_t * desc;
const char* driver_dir;
if ((driver_dir = getenv("JACK_DRIVER_DIR")) == 0) {
driver_dir = ADDON_DIR;
}
/* search through the driver_dir and add get descriptors
from the .so files in it */
dir_stream = opendir (driver_dir);
if (!dir_stream) {
jack_error ("could not open driver directory %s: %s\n",
driver_dir, strerror (errno));
return NULL;
}
while ((dir_entry = readdir(dir_stream))) {
ptr = strrchr (dir_entry->d_name, '.');
if (!ptr) {
continue;
}
ptr++;
if (strncmp ("so", ptr, 2) != 0) {
continue;
}
/* check if dll is an internal client */
if (!check_symbol(dir_entry->d_name, "jack_internal_initialize")) {
continue;
}
desc = jack_get_descriptor (internals, dir_entry->d_name, "jack_get_descriptor");
if (desc) {
driver_list = jack_slist_append (driver_list, desc);
} else {
jack_error ("jack_get_descriptor returns null for \'%s\'", dir_entry->d_name);
}
}
err = closedir (dir_stream);
if (err) {
jack_error ("error closing internal directory %s: %s\n",
driver_dir, strerror (errno));
}
if (!driver_list) {
jack_error ("could not find any internals in %s!", driver_dir);
return NULL;
}
return driver_list;
}
float config_parser_t::get_f(int symbol)
{
if(check_symbol(symbol) < 0)
return 0.0;
switch(table[symbol]->typecode)
{
case CFG_NONE:
return 0.0;
case CFG_BOOL:
{
cfg_switch_t *k = (cfg_switch_t *)table[symbol];
return *(k->value) ? 1.0 : 0.0;
}
case CFG_INT:
{
cfg_key_int_t *k = (cfg_key_int_t *)table[symbol];
return (float)*(k->value);
}
case CFG_FLOAT:
{
cfg_key_float_t *k = (cfg_key_float_t *)table[symbol];
return *(k->value);
}
case CFG_STRING:
{
cfg_key_string_t *k = (cfg_key_string_t *)table[symbol];
return atof(*(k->value));
}
}
return 0.0;
}
ns_value variable_node::set_value(ns_rt_context *rtctx, ns_value v) {
symbol *sym = check_symbol(id, rtctx);
if (sym) {
sym->value = v;
}
return sym->value;
}
/**
* test_visitor_null_visit:
* @fn test_visitor_null_visit
* Tests whether compilerkit_visitor_visit produces appropriate results in the CompilerKitVisitor struct.
* @pre None
* @param None
* @return void
*/
void test_visitor_null_visit(void)
{
GObject *symbol;
GObject *empty_set;
CompilerKitVisitor* visitor;
g_test_message ("Testing visitor null visits");
g_test_timer_start ();
symbol = compilerkit_symbol_new ('a');
empty_set = compilerkit_empty_set_get_instance ();
visitor = check_symbol();
// Assert that visitor produces the correct result
g_assert(compilerkit_visitor_visit(visitor, symbol) == symbol);
// NULL objects will produce NULL
g_assert(compilerkit_visitor_visit(visitor, NULL) == NULL);
// Nothing registered for empty set, so return NULL
g_assert(compilerkit_visitor_visit(visitor, empty_set) == NULL);
// Decrease the reference count for objects to free them.
g_object_unref (symbol);
g_object_unref (empty_set);
g_object_unref (visitor);
// This test shouldn't take too long to run
g_assert_cmpfloat(g_test_timer_elapsed (), <=, 1);
}
const char *config_parser_t::get_s(int symbol)
{
if(check_symbol(symbol) < 0)
return "";
switch(table[symbol]->typecode)
{
case CFG_NONE:
return "";
case CFG_BOOL:
{
cfg_switch_t *k = (cfg_switch_t *)table[symbol];
return *(k->value) ? "On" : "Off";
}
case CFG_INT:
{
cfg_key_int_t *k = (cfg_key_int_t *)table[symbol];
snprintf(retbuf, sizeof(retbuf)-1, "%d", *(k->value));
return retbuf;
}
case CFG_FLOAT:
{
cfg_key_float_t *k = (cfg_key_float_t *)table[symbol];
snprintf(retbuf, sizeof(retbuf)-1, "%f", *(k->value));
return retbuf;
}
case CFG_STRING:
{
cfg_key_string_t *k = (cfg_key_string_t *)table[symbol];
return *(k->value);
}
break;
}
return "";
}
int config_parser_t::get_default_i(int symbol)
{
if(check_symbol(symbol) < 0)
return 0;
switch(table[symbol]->typecode)
{
case CFG_NONE:
return 0;
case CFG_BOOL:
{
cfg_switch_t *k = (cfg_switch_t *)table[symbol];
return k->default_value ? 1 : 0;
}
case CFG_INT:
{
cfg_key_int_t *k = (cfg_key_int_t *)table[symbol];
return k->default_value;
}
case CFG_FLOAT:
{
cfg_key_float_t *k = (cfg_key_float_t *)table[symbol];
return (int)k->default_value;
}
case CFG_STRING:
{
cfg_key_string_t *k = (cfg_key_string_t *)table[symbol];
return atoi(k->default_value);
}
}
return 0;
}
void config_parser_t::set(int symbol, float value)
{
if(check_symbol(symbol) < 0)
return;
switch(table[symbol]->typecode)
{
case CFG_NONE:
return;
case CFG_BOOL:
{
cfg_switch_t *k = (cfg_switch_t *)table[symbol];
*(k->value) = value ? 1 : 0;
}
break;
case CFG_INT:
{
cfg_key_int_t *k = (cfg_key_int_t *)table[symbol];
*(k->value) = (int)value;
}
break;
case CFG_FLOAT:
{
cfg_key_float_t *k = (cfg_key_float_t *)table[symbol];
*(k->value) = value;
}
break;
case CFG_STRING:
{
cfg_key_string_t *k = (cfg_key_string_t *)table[symbol];
snprintf(*(k->value), CFG_STRING_LENGTH-1, "%f", value);
}
break;
}
table[symbol]->redefined = 1;
}
// ### autoload-macro
Value EXT_autoload_macro(unsigned int numargs, Value args[])
{
switch (numargs)
{
case 1:
if (listp(args[0]))
{
Value list = args[0];
while (list != NIL)
{
Value name = car(list);
check_symbol(name)->set_autoload_macro(new Autoload(name));
list = xcdr(list);
}
return T;
}
else if (symbolp(args[0]))
{
the_symbol(args[0])->set_autoload_macro(new Autoload(args[0]));
return T;
}
else
return signal_type_error(args[0], list3(S_or, S_symbol, S_list));
case 2:
if (listp(args[0]))
{
AbstractString * filename = check_string(args[1]);
Value list = args[0];
while (list != NIL)
{
Value name = car(list);
check_symbol(name)->set_autoload_macro(new Autoload(name, filename));
list = xcdr(list);
}
return T;
}
else if (symbolp(args[0]))
{
the_symbol(args[0])->set_autoload_macro(new Autoload(args[0], check_string(args[1])));
return T;
}
else
return signal_type_error(args[0], list3(S_or, S_symbol, S_list));
default:
return wrong_number_of_arguments(S_autoload, numargs, 1, 2);
}
}
ns_value variable_node::eval(ns_rt_context *rtctx) {
symbol *sym = check_symbol(id, rtctx);
if (!sym) {
ns_panic(lineno) << "can't find symbol `" << id
<< "` in symbol table";
}
return sym->value;
}
const char *config_parser_t::name(int symbol)
{
if(check_symbol(symbol) < 0)
return "<key does not exist!>";
if(table[symbol]->name)
return table[symbol]->name;
else
return "<key has no name>";
}
const char *config_parser_t::description(int symbol)
{
if(check_symbol(symbol) < 0)
return "<key does not exist!>";
if(table[symbol]->description)
return table[symbol]->description;
else
return "<key has no description>";
}
// ### resolve
Value EXT_resolve(Value arg)
{
Symbol * sym = check_symbol(arg);
TypedObject * function = sym->function();
if (function && function->widetag() == WIDETAG_AUTOLOAD)
reinterpret_cast<Autoload *>(function)->load();
function = sym->function();
if (function)
return make_value(function);
else
return NIL;
}
ns_value def_func_node::eval(ns_rt_context *rtctx) {
// push paramter stack
if (arg_list != NULL && rtctx->func_param_list->size() == arg_list->size()) {
auto it = arg_list->begin();
auto pit = rtctx->func_param_list->begin();
for (; it != arg_list->end(); ++it, ++pit) {
symbol *s = check_symbol(*it, rtctx);
s->value = *pit;
}
}
ns_value val = stmt_list->eval(rtctx);
return val;
}
// ### fasl-sharp-dollar stream sub-char numarg => value
Value SYS_fasl_sharp_dollar(Value streamarg, Value subchar, Value numarg)
{
Symbol * symbol = check_symbol(stream_read_symbol(streamarg, FASL_READTABLE));
Thread * thread = current_thread();
Value package = thread->symbol_value(S_fasl_anonymous_package);
if (package == NIL)
{
package = make_value(new Package());
thread->set_symbol_value(S_fasl_anonymous_package, package);
}
Value sym = check_package(package)->intern(symbol->name(), false);
the_symbol(sym)->set_package(NIL);
return sym;
}
void config_parser_t::set(int symbol, const char *text)
{
if(check_symbol(symbol) < 0)
return;
switch(table[symbol]->typecode)
{
case CFG_NONE:
return;
case CFG_BOOL:
{
/*
* Unfortunately, only *real* operating systems have
* strcasecmp(), so we have to mess around a little.
*/
char buf[16];
strncpy(buf, text, 15);
for(int i = 0; i < 15; ++i)
buf[i] = tolower(buf[i]);
cfg_switch_t *k = (cfg_switch_t *)table[symbol];
if( strncmp(buf, "yes", 3) || strncmp(buf, "true", 4) ||
strcmp(buf, "on") || strncmp(buf, "enable", 6) ||
strncmp(buf, "activ", 5) ||
strcmp(buf, "one") || strcmp(buf, "1") )
*(k->value) = 1;
else
*(k->value) = 0;
}
break;
case CFG_INT:
{
cfg_key_int_t *k = (cfg_key_int_t *)table[symbol];
*(k->value) = atoi(text);
}
break;
case CFG_FLOAT:
{
cfg_key_float_t *k = (cfg_key_float_t *)table[symbol];
*(k->value) = atof(text);
}
break;
case CFG_STRING:
{
cfg_key_string_t *k = (cfg_key_string_t *)table[symbol];
strncpy(*(k->value), text, CFG_STRING_LENGTH-1);
*(k->value)[CFG_STRING_LENGTH-1] = 0;
}
break;
}
table[symbol]->redefined = 1;
}
static action_t cont_macroexpand1() {
if (iscons(expr)) {
ref_t symbol = check_symbol(car(expr));
if (has_function(symbol)) {
ref_t func = get_function(symbol);
if (ismacro(func)) {
C(cont)->fn = cont_apply_apply, C(cont)->val[0] = func;
expr = cdr(expr);
return ACTION_APPLY_CONT;
}
}
}
pop_cont();
return ACTION_APPLY_CONT;
}
static action_t cont_list() {
ref_t sym = check_symbol(car(expr));
expr = cdr(expr);
if (sym == sym_do)
eval_do(expr);
else if (sym == sym_fn)
C(cont)->fn = cont_fn;
else if (sym == sym_if)
C(cont)->fn = cont_if;
else if (sym == sym_quote)
C(cont)->fn = cont_quote;
else
eval_apply(get_function(sym));
return ACTION_APPLY_CONT;
}
static inline int
check_image (const zbar::Image &img)
{
zbar::SymbolSet syms(img.get_symbols());
int setn = syms.get_size(), countn = 0;
int rc = 0;
for(zbar::SymbolIterator sym(syms.symbol_begin());
sym != syms.symbol_end();
++sym, ++countn)
rc |= check_symbol(img, *sym);
if(countn != setn)
rc |= error("SymbolSet size mismatch: exp=" + to_string(setn) +
" act=" + to_string(countn));
return(rc);
}
/*
* See whether an expression contains the configuration variable name.
* Recursively search in symbols referenced in the expression.
*/
bool find_dep(struct expr *e, char *name)
{
struct expr *left, *right;
struct symbol *sym;
left = e->left.expr;
right = e->right.expr;
sym = e->left.sym;
switch (e->type) {
case E_SYMBOL:
case E_EQUAL:
case E_UNEQUAL:
return check_symbol(sym, name);
case E_NOT:
return find_dep(left, name);
case E_OR:
return find_dep(left, name) || find_dep(right, name);
case E_AND:
return find_dep(left, name) && find_dep(right, name);
/* case E_LIST: */
/* //E_LIST is created in menu_finalize and is related to <choice> */
/* printf("%s ", e->right.sym->name); */
/* if (e->left.expr) { */
/* printf("^ "); */
/* expr_to_bdd(e->left.expr); */
/* } */
/* break; */
/* case E_RANGE: */
/* printf("["); */
/* printf("%s ", e->left.sym->name); */
/* printf("%s", e->right.sym->name); */
/* printf("]"); */
/* break; */
default:
fprintf(stderr, "error: invalid expression type\n");
exit(1);
}
}
std::string check_sizzling::find_symbol_and_change_if_need(string text) const
{
int i;
for(i=0; i<20; i++)
if (text[i] == 'r' || text[i] == 'n'||text[i] == 'v')
switch(check_symbol(text[i+1])){
case 0:
text[i+1] = 'a';
break;
case 1:
text[i+1] = 'u';
break;
case 2:
text[i+1] = 'e';
break;
default: break;
}
return text;
}
void BidlParser::parse(const std::string& bidl) {
do_parse(bidl);
int32_t matrix_size = _input_bidls.size();
if (matrix_size > MATRIX_SIZE) {
myerror("too mary include bidls. max size is %d", MATRIX_SIZE);
}
relation2matrix();
check4circle();
std::vector<std::string> ordered_input_bidls = get_ordered_bidl();
std::vector<std::string>::const_iterator itr;
for (itr = ordered_input_bidls.begin();
itr != ordered_input_bidls.end();
++itr) {
check_symbol(*itr);
}
generate_source_code();
}
cfg_types_t config_parser_t::type(int symbol)
{
if(check_symbol(symbol) < 0)
return CFG_NONE;
return table[symbol]->typecode;
}
/*Code included as part of assignment
* modified to manipulate existing data
*/
bool tree_insert(struct tree *t, struct company *comp,
int (*cmp)(const struct company *, const struct company *))
{
// insert left
bool rValue = false;
if(cmp(comp, t->data) == -1) {
if (t->left) {
return tree_insert(t->left, comp, cmp);
} else {
if(comp->cents < .01) { // does not match any known data and is invalid value
fprintf(stderr, "ERROR: stock price cannot be less than $.01\n");
return false;
}
t->left = tree_create(comp);
return t->left;
}
//insert right
} else if (cmp(comp, t->data) == 1) {
if (t->right) {
return tree_insert(t->right, comp, cmp);
} else {
if(comp->cents < .01) { // does not match any known data and is invalid value
fprintf(stderr, "ERROR: stock price cannot be less than $.01\n");
return false;
}
t->right = tree_create(comp);
return t->right;
}
// insert at head
} else if(t->data == NULL) {
t->data = comp;
// the symbol is the same
} else if( check_symbol(comp, t->data) == 0) { // using the same symbol
int temp = t->data->cents + comp->cents;
if (temp > 0) {
t->data->cents = temp;
rValue = true;
} else {
fprintf(stderr, "ERROR: stock price cannot be less than $.01\n");
}
free(comp->name);
free(comp);
return rValue;
// data is the same but symbol is different
} else if(cmp(comp, t->data) ==0) {
if (t->left) {
return tree_insert(t->left, comp, cmp);
} else {
t->left = tree_create(comp);
return t->left;
} // arbitrarly insert to the left
}
else {
free(comp->name);
free(comp);
return rValue;
}
return false;
}
int config_parser_t::do_save(int symbol)
{
if(check_symbol(symbol) < 0)
return CFG_NONE;
return table[symbol]->save;
}
int main(int argc, char **argv)
{
int opt;
char *kconfig;
struct symbol *sym;
int i;
char *name;
progname = argv[0];
if (1 == argc)
print_usage();
setlocale(LC_ALL, "");
bindtextdomain(PACKAGE, LOCALEDIR);
textdomain(PACKAGE);
opterr = 0;
while (1) {
static struct option long_options[] = {
{"depsym", no_argument, &action, A_DEPSYM},
{"idepsym", no_argument, &action, A_IDEPSYM},
{"nonbools", no_argument, &action, A_NONBOOLS},
{"bools", no_argument, &action, A_BOOLS},
{"tristate", no_argument, &action, A_TRISTATE},
{"configs", no_argument, &action, A_CONFIGS},
{"kconfigs", no_argument, &action, A_KCONFIGS},
{"menusyms", no_argument, &action, A_MENUSYMS},
{"defaults", no_argument, &action, A_DEFAULTS},
{"symdeps", no_argument, &action, A_SYMDEPS},
{"defdeps", no_argument, &action, A_DEFDEPS},
{"everyyes", no_argument, &action, A_EVERYYES},
{"everyno", no_argument, &action, A_EVERYNO},
{"everydef", no_argument, &action, A_EVERYDEF},
{"everyyesi", no_argument, &action, A_EVERYYESI},
{"forceoff", required_argument, 0, 'f'},
{"forceoffall", required_argument, 0, 'a'},
{"search", required_argument, &action, A_SEARCH},
{"deps", required_argument, &action ,A_DEPS},
{"dump", no_argument, &action ,A_DUMP},
{"Configure", no_argument, 0, 'C'},
{"default-env", no_argument, 0, 'd'},
{"verbose", no_argument, 0, 'v'},
{"help", no_argument, 0, 'h'},
{0, 0, 0, 0}
};
int option_index = 0;
opt = getopt_long(argc, argv, "Cdhf:a:v", long_options, &option_index);
if (-1 == opt)
break;
FILE *tmp;
char *line;
size_t len;
ssize_t read;
struct linked_list *last;
switch (opt) {
case 0:
action_arg = optarg;
break;
case 'f':
forceoff = optarg;
break;
case 'a':
tmp = fopen(optarg, "r");
line = NULL;
len = 0;
if (!tmp) {
perror("fopen");
exit(1);
}
last = NULL;
while ((read = getline(&line, &len, tmp)) != -1) {
struct linked_list *tmp = malloc(sizeof(struct linked_list));
char *p;
for (p = line; *p != '\0'; p++)
if (*p == '\n') {
*p = '\0';
break;
}
tmp->next = NULL;
tmp->data = line;
/* printf("%s\n", line); */
if (NULL == last) {
last = forceoffall = tmp;
} else {
last->next = tmp;
last = tmp;
}
line = NULL; //force getline to allocate a new buffer
}
fclose(tmp);
break;
case 'C':
bconf_parser = true;
break;
case 'd':
default_env = true;
break;
case 'v':
verbose = true;
break;
case 'h':
print_usage();
break;
case ':':
case '?':
fprintf(stderr, "Invalid option or missing argument. For help use -h\n");
exit(1);
break;
}
}
if (A_NONE == action) {
fprintf(stderr, "Please specify an action. For help use -h.\n");
exit(1);
}
if (default_env) {
putenv("SRCARCH=x86");
putenv("ARCH=x86_64");
putenv("KERNELVERSION=kcu");
}
if (optind < argc)
kconfig = argv[optind++];
else
kconfig = "Kconfig";
if (bconf_parser) {
bconf_parse(kconfig);
} else {
conf_parse(kconfig);
}
switch (action) {
case A_SEARCH:
for_all_symbols(i, sym) {
sym->searched = false;
sym->depends = false;
}
for_all_symbols(i, sym)
check_symbol(sym, action_arg);
break;
case A_DEFAULTS:
for_all_symbols(i, sym) {
static bool def;
if (!sym->name || strlen(sym->name) == 0)
continue;
def = is_default(sym);
if (def)
printf("%s\n", sym->name);
}
break;
case A_CONFIGS:
for_all_symbols(i, sym) {
if (!sym->name || strlen(sym->name) == 0)
continue;
printf("%s\n", sym->name);
}
break;
case A_KCONFIGS:
for_all_symbols(i, sym) {
if (!sym->name || strlen(sym->name) == 0)
continue;
if (is_symbol(sym))
printf("%s\n", sym->name);
}
break;
case A_EVERYYES:
for_all_symbols(i, sym) {
sym->searched = false;
sym->depends = false;
}
Value CL_symbol_macrolet(Value args, Environment * env, Thread * thread)
{
Value varlist = check_list(car(args));
Value result = NIL;
void * last_special_binding = thread->last_special_binding();
Environment * ext = new Environment(env);
if (varlist != NIL)
{
for (unsigned long i = length(varlist); i-- > 0;)
{
Value obj = car(varlist);
varlist = xcdr(varlist);
if (consp(obj) && length(obj) == 2)
{
Value name = xcar(obj);
Symbol * sym = check_symbol(name);
if (sym->is_special_variable() || env->is_declared_special(name))
{
String * s = new String("Attempt to bind the special variable ");
s->append(::prin1_to_string(name));
s->append(" with SYMBOL-MACROLET.");
return signal_lisp_error(new ProgramError(s));
}
ext->bind(name, make_value(new SymbolMacro(xcar(xcdr(obj)))));
}
else
{
String * s = new String("Malformed symbol-expansion pair in SYMBOL-MACROLET: ");
s->append(::prin1_to_string(obj));
return signal_lisp_error(new ProgramError(s));
}
}
}
Value body = xcdr(args);
// Process declarations.
Value specials = NIL;
while (body != NIL)
{
Value obj = car(body);
if (consp(obj) && xcar(obj) == S_declare)
{
Value decls = xcdr(obj);
while (decls != NIL)
{
Value decl = car(decls);
if (consp(decl) && xcar(decl) == S_special)
{
Value vars = xcdr(decl);
while (vars != NIL)
{
Value name = car(vars);
// "If declaration contains a special declaration that
// names one of the symbols being bound by SYMBOL-MACROLET,
// an error of type PROGRAM-ERROR is signaled."
Value list = xcar(args);
while (list != NIL)
{
if (xcar(xcar(list)) == name)
{
String * s = new String(::prin1_to_string(name));
s->append(" is a symbol-macro and thus can't be declared special.");
return signal_lisp_error(new ProgramError(s));
}
list = xcdr(list);
}
specials = make_cons(name, specials);
vars = xcdr(vars);
}
}
decls = xcdr(decls);
}
body = xcdr(body);
}
else
break;
}
while (specials != NIL)
{
ext->declare_special(xcar(specials));
specials = xcdr(specials);
}
while (body != NIL)
{
result = eval(car(body), ext, thread);
body = xcdr(body);
}
thread->set_last_special_binding(last_special_binding);
return result;
}
bool lt(ast * n1, ast * n2) {
unsigned num;
start:
if (n1 == n2)
return false;
check_value(n1->get_kind(), n2->get_kind());
switch(n1->get_kind()) {
case AST_SORT:
check_symbol(to_sort(n1)->get_name(), to_sort(n2)->get_name());
check_value(to_sort(n1)->get_num_parameters(), to_sort(n2)->get_num_parameters());
num = to_sort(n1)->get_num_parameters();
SASSERT(num > 0);
for (unsigned i = 0; i < num; i++) {
parameter p1 = to_sort(n1)->get_parameter(i);
parameter p2 = to_sort(n2)->get_parameter(i);
check_parameter(p1, p2);
}
UNREACHABLE();
return false;
case AST_FUNC_DECL:
check_symbol(to_func_decl(n1)->get_name(), to_func_decl(n2)->get_name());
check_value(to_func_decl(n1)->get_arity(), to_func_decl(n2)->get_arity());
check_value(to_func_decl(n1)->get_num_parameters(), to_func_decl(n2)->get_num_parameters());
num = to_func_decl(n1)->get_num_parameters();
for (unsigned i = 0; i < num; i++) {
parameter p1 = to_func_decl(n1)->get_parameter(i);
parameter p2 = to_func_decl(n2)->get_parameter(i);
check_parameter(p1, p2);
}
num = to_func_decl(n1)->get_arity();
for (unsigned i = 0; i < num; i++) {
ast * d1 = to_func_decl(n1)->get_domain(i);
ast * d2 = to_func_decl(n2)->get_domain(i);
check_ast(d1, d2);
}
n1 = to_func_decl(n1)->get_range();
n2 = to_func_decl(n2)->get_range();
goto start;
case AST_APP:
check_value(to_app(n1)->get_num_args(), to_app(n2)->get_num_args());
check_value(to_app(n1)->get_depth(), to_app(n2)->get_depth());
check_ast(to_app(n1)->get_decl(), to_app(n2)->get_decl());
num = to_app(n1)->get_num_args();
for (unsigned i = 0; i < num; i++) {
expr * arg1 = to_app(n1)->get_arg(i);
expr * arg2 = to_app(n2)->get_arg(i);
check_ast(arg1, arg2);
}
UNREACHABLE();
return false;
case AST_QUANTIFIER:
check_bool(to_quantifier(n1)->is_forall(), to_quantifier(n2)->is_forall());
check_value(to_quantifier(n1)->get_num_decls(), to_quantifier(n2)->get_num_decls());
check_value(to_quantifier(n1)->get_num_patterns(), to_quantifier(n2)->get_num_patterns());
check_value(to_quantifier(n1)->get_num_no_patterns(), to_quantifier(n2)->get_num_no_patterns());
check_value(to_quantifier(n1)->get_weight(), to_quantifier(n2)->get_weight());
num = to_quantifier(n1)->get_num_decls();
for (unsigned i = 0; i < num; i++) {
check_symbol(to_quantifier(n1)->get_decl_name(i), to_quantifier(n2)->get_decl_name(i));
check_ast(to_quantifier(n1)->get_decl_sort(i), to_quantifier(n2)->get_decl_sort(i));
}
num = to_quantifier(n1)->get_num_patterns();
for (unsigned i = 0; i < num; i++) {
check_ast(to_quantifier(n1)->get_pattern(i), to_quantifier(n2)->get_pattern(i));
}
num = to_quantifier(n1)->get_num_no_patterns();
for (unsigned i = 0; i < num; i++) {
check_ast(to_quantifier(n1)->get_no_pattern(i), to_quantifier(n2)->get_no_pattern(i));
}
n1 = to_quantifier(n1)->get_expr();
n2 = to_quantifier(n2)->get_expr();
goto start;
case AST_VAR:
check_value(to_var(n1)->get_idx(), to_var(n2)->get_idx());
n1 = to_var(n1)->get_sort();
n2 = to_var(n2)->get_sort();
goto start;
default:
UNREACHABLE();
return false;
}
}
// ### set-source
Value SYS_set_source(Value arg1, Value arg2)
{
check_symbol(arg1)->put(S_source_internal, arg2);
return arg2;
}