void
dictionary_rep::load (url u) {
if (is_none (u)) return;
if (is_or (u)) {
load (u[1]);
load (u[2]);
return;
}
string s;
if (load_string (u, s, false)) return;
tree t= block_to_scheme_tree (s);
if (!is_tuple (t)) return;
int i, n= N(t);
for (i=0; i<n; i++)
if (is_func (t[i], TUPLE, 2) &&
is_atomic (t[i][0]) && is_atomic (t[i][1]))
{
string l= t[i][0]->label; if (is_quoted (l)) l= scm_unquote (l);
string r= t[i][1]->label; if (is_quoted (r)) r= scm_unquote (r);
if (to == "chinese" || to == "japanese" || to == "german" ||
to == "korean" || to == "taiwanese" ||
to == "russian" || to == "ukrainian" || to == "bulgarian")
r= utf8_to_cork (r);
table (l)= r;
}
}
static string
get_prompt (scheme_tree p, int i) {
if (is_atomic (p[i]) && is_quoted (p[i]->label))
return translate (scm_unquote (p[i]->label));
else if (is_tuple (p[i]) && N(p[i])>0) {
if (is_atomic (p[i][0]) && is_quoted (p[i][0]->label))
return translate (scm_unquote (p[i][0]->label));
return translate (scheme_tree_to_tree (p[i][0]));
}
return translate ("Input:");
}
db_constraint
database_rep::encode_constraint (tree q) {
db_constraint r;
if (!is_tuple (q)) return db_constraint ();
if (N(q) <= 1 || !is_atomic (q[0])) return db_constraint ();
string attr= q[0]->label;
if (attr == "any")
r << -1;
else if (attr == "keywords")
return encode_keywords_constraint (q);
else if (attr == "order") {
r << -2;
return r;
}
else if (attr == "modified") {
r << -2;
return r;
}
else if (!is_quoted (q[0]->label))
return db_constraint ();
else if (atom_encode->contains (scm_unquote (q[0]->label)))
r << atom_encode [scm_unquote (q[0]->label)];
else return db_constraint ();
for (int i=1; i<N(q); i++)
if (atom_encode->contains (scm_unquote (q[i]->label)))
r << atom_encode [scm_unquote (q[i]->label)];
return r;
}
static string
get_type (scheme_tree p, int i) {
if (is_tuple (p[i]) && N(p[i])>1 &&
is_atomic (p[i][1]) && is_quoted (p[i][1]->label))
return scm_unquote (p[i][1]->label);
return "string";
}
void load_html_entities (hashmap<string, string> table, string fname) {
string s;
if (DEBUG_CONVERT) debug_convert << "Loading " << fname << "\n";
if (load_string (url ("$TEXMACS_PATH/langs/encoding", fname), s, false)) return;
tree t= block_to_scheme_tree (s);
if (!is_tuple (t)) return;
int i, n= N(t);
for (i=0; i<n; i++)
if (is_func (t[i], TUPLE, 2) &&
is_atomic (t[i][0]) && is_atomic (t[i][1]))
{
string l= t[i][0]->label; if (is_quoted (l)) l= scm_unquote (l);
string r= t[i][1]->label; if (is_quoted (r)) r= scm_unquote (r);
table (l)= r;
}
}
static array<string>
get_proposals (scheme_tree p, int i) {
array<string> a;
if (is_tuple (p[i]) && N(p[i]) >= 2) {
int j, n= N(p[i]);
for (j=2; j<n; j++)
if (is_atomic (p[i][j]) && is_quoted (p[i][j]->label))
a << scm_unquote (p[i][j]->label);
}
return a;
}
static bool
explicit_query_quote(T test, size_t len)
{
mysqlpp::Query q(0);
q << mysqlpp::quote << test;
if (!is_quoted(q.str(), test, len)) {
std::cerr << "Explicit quote of " << typeid(test).name() <<
" in Query failed: " << q.str() << std::endl;
return false;
}
mysqlpp::SQLStream s(0);
s << mysqlpp::quote << test;
if (is_quoted(s.str(), test, len)) {
return true;
}
else {
std::cerr << "Explicit quote of " << typeid(test).name() <<
" in Query failed: " << q.str() << std::endl;
return false;
}
}
static bool
no_explicit_ostream_quote(T test, size_t len)
{
std::ostringstream outs;
outs << mysqlpp::quote << test;
if (!is_quoted(outs.str(), test, len)) {
return true;
}
else {
std::cerr << "Explicit quote of " << typeid(test).name() <<
" in ostream erroneously honored!" << std::endl;
return false;
}
}
static enum status_code
parse_color_name(const char *color, struct line_rule *rule, const char **prefix_ptr)
{
const char *prefixend = is_quoted(*color) ? NULL : strchr(color, '.');
if (prefixend) {
struct keymap *keymap = get_keymap(color, prefixend - color);
if (!keymap)
return ERROR_UNKNOWN_KEY_MAP;
*prefix_ptr = keymap->name;
color = prefixend + 1;
}
if (is_quoted(*color)) {
rule->line = color + 1;
rule->linelen = strlen(color) - 2;
} else {
rule->name = color;
rule->namelen = strlen(color);
}
return SUCCESS;
}
void
edit_interface_rep::custom_complete (tree r) {
if (!is_tuple (r)) return;
int i, n= N(r);
string prefix;
array<string> compls;
for (i=0; i<n; i++)
if (is_atomic (r[i])) {
string l= r[i]->label;
if (is_quoted (l)) l= scm_unquote (l);
if (prefix == "") prefix= l;
else compls << l;
}
// cout << prefix << ", " << compls << LF;
if ((prefix == "") || (N(compls) == 0)) return;
complete_start (prefix, compls);
}
static pSlipObject slip_eval(pSlip gd, pSlipObject exp, pSlipEnvironment env)
{
pSlipObject proc;
pSlipObject args;
tailcall:
if (is_self_evaluating(exp) == S_TRUE)
{
return exp;
}
else if (is_variable(exp) == S_TRUE)
{
return lookup_variable_value(gd, exp, env);
}
else if (is_quoted(gd, exp) == S_TRUE)
{
return text_of_quotation(exp);
}
else if (is_assignment(gd, exp) == S_TRUE)
{
return eval_assignment(gd, exp, env);
}
else if (is_definition(gd, exp) == S_TRUE)
{
return eval_definition(gd, exp, env);
}
else if (is_if(gd, exp) == S_TRUE)
{
exp = is_true(gd, slip_eval(gd, if_predicate(exp), env)) == S_TRUE ? if_consequent(exp) : if_alternative(gd, exp);
goto tailcall;
}
else if (is_lambda(gd, exp) == S_TRUE)
{
return s_NewCompoundProc(gd, lambda_parameters(exp), lambda_body(exp), env);
}
else if (is_begin(gd, exp) == S_TRUE)
{
exp = begin_actions(exp);
while (!is_last_exp(gd, exp))
{
slip_eval(gd, first_exp(exp), env);
exp = rest_exps(exp);
}
exp = first_exp(exp);
goto tailcall;
}
else if (is_cond(gd, exp) == S_TRUE)
{
exp = cond_to_if(gd, exp);
goto tailcall;
}
else if (is_let(gd, exp) == S_TRUE)
{
exp = let_to_application(gd, exp);
goto tailcall;
}
else if (is_application(exp) == S_TRUE)
{
proc = slip_eval(gd, slip_operator(exp), env);
if (proc == NULL)
return gd->singleton_False;
if (proc->type == eType_PRIMITIVE_PROC || proc->type == eType_COMPOUND_PROC)
{
args = list_of_values(gd, operands(exp), env);
if (args == NULL)
return gd->singleton_False;
if (sIsObject_PrimitiveProc(proc) == S_TRUE)
{
return proc->data.prim_proc.func(gd, args);
}
else if (sIsObject_CompoundProc(proc) == S_TRUE)
{
env = setup_environment(gd, proc->data.comp_proc.env, proc->data.comp_proc.params, args);
exp = make_begin(gd, proc->data.comp_proc.code);
goto tailcall;
}
else
{
throw_error(gd, "unknown procedure type\n");
return gd->singleton_False;
}
}
else
return proc;
}
else
{
throw_error(gd, "cannot eval unknown expression type\n");
return NULL;
}
throw_error(gd, "what??\n");
return NULL;
}
// split a string into individual tokens
void tokenise(const std::string &line, const std::string &filename, int line_num, const Options &opt,
/*out*/ std::vector<Token> &tokens,
bool test_is_raw_python = false // whether --test input is raw python code (vs just a list of boolean expressions)
)
{
size_t pos = 0;
size_t len = line.length();
bool found_assign_op = false;
bool ids_can_be_keywords = opt.assign || (opt.test && !test_is_raw_python);
while (pos < len)
{
size_t space_start = pos;
// skip whitespace (and finish if end of line or comment)
while (std::isspace(char_at(line, pos))) { ++pos; }
if (pos >= len || line[pos] == '#') { break; }
size_t num_spaces = pos - space_start;
size_t tok_start = pos;
char ch = line[pos];
char next_ch = char_at(line, pos + 1);
token_type type = t_undefined;
std::string tok_str;
if (opt.assign && found_assign_op)
{
type = t_string;
pos = len;
tok_str = trim_spaces(line.substr(tok_start, pos - tok_start));
if (is_quoted(tok_str))
{
// make sure quotes are of the right type
std::string unquoted_tok_str = tok_str.substr(1, tok_str.length() - 2);
tok_str = quote(unquoted_tok_str, '\'');
}
else if (!is_number(tok_str)) { tok_str = quote(tok_str, '\''); }
}
else
if (is_start_of_id(ch))
{
// TODO: maybe allow spaces around array indexes , e.g. "a/b[ 10 ]/c"
while (is_id(char_at(line, pos))) { ++pos; }
std::string id = line.substr(tok_start, pos - tok_start);
check_transform_id(id);
if (is_keyword(id) && !(ids_can_be_keywords && is_keyword_allowed_as_id(id))) { tok_str = id; type = t_keyword; }
else if (id != kwd_expect && next_nonblank_char(line, pos) == '(') { tok_str = id; type = t_function; }
else { tok_str = (opt.demangle ? demangle_id(id, true) : mangle_id(id)); type = t_id; }
}
else
if (std::isdigit(ch) ||
(ch == '.' && std::isdigit(next_ch)) ||
(ch == '-' && (std::isdigit(next_ch) || next_ch == '.')))
{
bool any_digits = false;
if (ch == '-') { ++pos; }
while (std::isdigit(char_at(line, pos))) { ++pos; any_digits = true; }
if (char_at(line, pos) == '.')
{
++pos;
while (std::isdigit(char_at(line, pos))) { ++pos; any_digits = true; }
}
// check for scientific notation
// (TODO: merge common code with is_number function)
if (any_digits && std::tolower(char_at(line, pos)) == 'e')
{
size_t pos2 = pos + 1;
if (char_at(line, pos2) == '+' || char_at(line, pos2) == '-')
{
++pos2;
if (std::isdigit(char_at(line, pos2)))
{ for (pos = pos2 + 1;std::isdigit(char_at(line, pos));++pos) { } }
}
}
if (any_digits) { type = t_number; }
else { type = t_operator; pos = tok_start + 1; } // token is a single character ("-" or ".")
tok_str = line.substr(tok_start, pos - tok_start);
}
else
if (ch == '\"' || ch == '\'')
{
for (++pos;pos < len && line[pos] != ch;++pos)
{
// check for escape character
if (line[pos] == '\\') { if (++pos >= len) break; }
}
if (pos < len) { ++pos; }
tok_str = line.substr(tok_start, pos - tok_start);
type = t_string;
}
else
{
pos += operator_length(line, pos);
tok_str = line.substr(tok_start, pos - tok_start);
type = t_operator;
if (tok_str == "=")
{
found_assign_op = true;
if (opt.test && (!test_is_raw_python ||
(tokens.size() > 0 && tokens[0].type == t_id && tokens[0].str == kwd_expect)))
{ tok_str = "=="; }
}
}
tokens.push_back(Token(type, tok_str, num_spaces));
if (!opt.command && tokens.size() == 1)
{
// Python will complain if the line is indented
tokens[0].spaces_before = 0;
}
}
transform_special_tokens(tokens, filename, line_num);
if (opt.assign)
{
// transform var= into var=''
if (tokens.size() == 2 && tokens[1].str == "=") { tokens.push_back(Token(t_string, "''", 0)); }
}
if (opt.test) { force_string_comparison_if_quoted(tokens); }
if (opt.command)
{
// add any missing ":" at the end of the line
if (tokens.size() > 0 && tokens[0].type == t_keyword)
{
// check if there is a ":" anywhere in the line
if (find_token(tokens, t_operator, ":") == -1)
{
if (tokens[0].str == "if" || tokens[0].str == "else" || tokens[0].str == "elif" ||
tokens[0].str == "while" || tokens[0].str == "for" || tokens[0].str == "try" ||
tokens[0].str == "except" || tokens[0].str == "finally")
{ tokens.push_back(Token(t_operator, ":", 0)); }
}
}
}
}
char *get_namelist(
char *s,
long n,
FILE *fp
)
{
register char *flag, *ptr, *ptr1;
register long l;
while ((flag=CNL_fgetsSkipComments(s, n, fp, '!'))) {
if ((ptr=strchr(s, '&'))) {
if (!is_quoted(s, ptr, '"'))
break;
}
#if DOLLARSIGN_TOO
if (ptr=strchr(s, '$')) {
if (!is_quoted(s, ptr, '"'))
break;
}
#endif
}
#ifdef DEBUG
printf("get_namelist: s = <%s>\n", s);
#endif
if (flag==NULL)
return(NULL);
#if DOLLARSIGN_TOO
if ((count_occurences(s, '$', "")+count_occurences(s, '&', ""))>=2)
return(s);
#else
if (count_occurences(s, '&', "")>=2)
return(s);
#endif
s[strlen(s)-1] = ' ';
/* chop_nl(s); */
ptr = s;
do {
l = strlen(ptr);
ptr += l;
if ((n-=l)<=1) {
puts("error: namelist text buffer too small");
abort();
}
do {
if (!CNL_fgetsSkipComments(ptr, n, fp, '!'))
return(s);
if (ptr[0]!='!')
break;
} while (1);
*(ptr+strlen(ptr)-1) = ' ';
/* chop_nl(ptr); */
if ((ptr1=strrchr(ptr, '&'))) {
if (!is_quoted(s, ptr1, '"'))
break;
}
#if DOLLARSIGN_TOO
if (ptr1=strrchr(ptr, '$')) {
if (!is_quoted(s, ptr1, '"'))
break;
}
#endif
} while (1) ;
return(s);
}
object *bs_eval(object *exp, object *env)
{
tailcall:
if (is_empty_list(exp)) {
error("unable to evaluate empty list");
} else if (is_self_evaluating(exp)) {
return exp;
} else if (is_variable(exp)) {
return lookup_variable_value(exp, env);
} else if (is_quoted(exp)) {
return quoted_expression(exp);
} else if (is_assignment(exp)) {
return eval_assignment(exp, env);
} else if (is_definition(exp)) {
return eval_definition(exp, env);
} else if (is_if(exp)) {
if (is_true(bs_eval(if_predicate(exp), env))) {
exp = if_consequent(exp);
} else {
exp = if_alternate(exp);
}
goto tailcall;
} else if (is_lambda(exp)) {
return make_compound_proc(lambda_parameters(exp),
lambda_body(exp),
env);
} else if (is_begin(exp)) {
exp = begin_actions(exp);
if (is_empty_list(exp)) {
error("empty begin block");
}
while (!is_empty_list(cdr(exp))) {
bs_eval(car(exp), env);
exp = cdr(exp);
}
exp = car(exp);
goto tailcall;
} else if (is_cond(exp)) {
exp = cond_to_if(exp);
goto tailcall;
} else if (is_let(exp)) {
exp = let_to_application(exp);
goto tailcall;
} else if (is_and(exp)) {
exp = and_tests(exp);
if (is_empty_list(exp)) {
return get_boolean(1);
}
object *result;
while (!is_empty_list(cdr(exp))) {
result = bs_eval(car(exp), env);
if (is_false(result)) {
return result;
}
exp = cdr(exp);
}
exp = car(exp);
goto tailcall;
} else if (is_or(exp)) {
exp = or_tests(exp);
if (is_empty_list(exp)) {
return get_boolean(0);
}
object *result;
while (!is_empty_list(cdr(exp))) {
result = bs_eval(car(exp), env);
if (is_true(result)) {
return result;
}
exp = cdr(exp);
}
exp = car(exp);
goto tailcall;
} else if (is_application(exp)) {
object *procedure = bs_eval(application_operator(exp), env);
object *parameters = eval_parameters(application_operands(exp), env);
// handle eval specially for tailcall requirement.
if (is_primitive_proc(procedure) &&
procedure->value.primitive_proc == eval_proc) {
exp = eval_expression(parameters);
env = eval_environment(parameters);
goto tailcall;
}
// handle apply specially for tailcall requirement.
if (is_primitive_proc(procedure) &&
procedure->value.primitive_proc == apply_proc) {
procedure = apply_operator(parameters);
parameters = apply_operands(parameters);
}
if (is_primitive_proc(procedure)) {
return (procedure->value.primitive_proc)(parameters);
} else if (is_compound_proc(procedure)) {
env = extend_environment(
procedure->value.compound_proc.parameters,
parameters,
procedure->value.compound_proc.env);
exp = make_begin(procedure->value.compound_proc.body);
goto tailcall;
} else {
error("unable to apply unknown procedure type");
}
} else {
error("unable to evaluate expression");
}
}
static bool
is_quoted(const std::string& s, mysqlpp::Null<T> orig_str, size_t orig_len)
{
return is_quoted(s, orig_str.data, orig_len);
}
object *eval(object *exp, object *env) {
object *procedure;
object *arguments;
object *result;
bool tailcall = false;
do {
if (is_self_evaluating(exp))
return exp;
if (is_variable(exp))
return lookup_variable_value(exp, env);
if (is_quoted(exp))
return text_of_quotation(exp);
if (is_assignment(exp))
return eval_assignment(exp, env);
if (is_definition(exp))
return eval_definition(exp, env);
if (is_if(exp)) {
exp = is_true(eval(if_predicate(exp), env)) ? if_consequent(exp) : if_alternative(exp);
tailcall = true;
continue;
}
if (is_lambda(exp))
return make_compound_proc(lambda_parameters(exp), lambda_body(exp), env);
if (is_begin(exp)) {
exp = begin_actions(exp);
while (!is_last_exp(exp)) {
eval(first_exp(exp), env);
exp = rest_exps(exp);
}
exp = first_exp(exp);
tailcall = true;
continue;
}
if (is_cond(exp)) {
exp = cond_to_if(exp);
tailcall = true;
continue;
}
if (is_let(exp)) {
exp = let_to_application(exp);
tailcall = true;
continue;
}
if (is_and(exp)) {
exp = and_tests(exp);
if (is_empty(exp))
return make_boolean(true);
while (!is_last_exp(exp)) {
result = eval(first_exp(exp), env);
if (is_false(result))
return result;
exp = rest_exps(exp);
}
exp = first_exp(exp);
tailcall = true;
continue;
}
if (is_or(exp)) {
exp = or_tests(exp);
if (is_empty(exp)) {
return make_boolean(false);
}
while (!is_last_exp(exp)) {
result = eval(first_exp(exp), env);
if (is_true(result))
return result;
exp = rest_exps(exp);
}
exp = first_exp(exp);
tailcall = true;
continue;
}
if (is_application(exp)) {
procedure = eval(operator(exp), env);
arguments = list_of_values(operands(exp), env);
if (is_primitive_proc(procedure) && procedure->data.primitive_proc.fn == eval_proc) {
exp = eval_expression(arguments);
env = eval_environment(arguments);
tailcall = true;
continue;
}
if (is_primitive_proc(procedure) && procedure->data.primitive_proc.fn == apply_proc) {
procedure = apply_operator(arguments);
arguments = apply_operands(arguments);
}
if (is_primitive_proc(procedure))
return (procedure->data.primitive_proc.fn)(arguments);
if (is_compound_proc(procedure)) {
env = extend_environment(procedure->data.compound_proc.parameters, arguments, procedure->data.compound_proc.env);
exp = make_begin(procedure->data.compound_proc.body);
tailcall = true;
continue;
}
return make_error(342, "unknown procedure type");
} // is_application()
} while (tailcall);
fprintf(stderr, "cannot eval unknown expression type\n");
exit(EXIT_FAILURE);
}
///////////////////////////////////////////////////////////////////
//eval
//requires two arguments:exp & tail_context
///////////////////////////////////////////////////////////////////
cellpoint eval(void)
{
if (is_true(is_self_evaluating(args_ref(1)))){
reg = args_ref(1);
}else if (is_true(is_variable(args_ref(1)))){
reg = args_ref(1);
args_push(current_env);
args_push(reg);
reg = lookup_var_val();
}else if (is_true(is_quoted(args_ref(1)))){
args_push(args_ref(1));
reg = quotation_text();
}else if (is_true(is_assignment(args_ref(1)))){
args_push(args_ref(1));
reg = eval_assignment();
}else if (is_true(is_definition(args_ref(1)))){
args_push(args_ref(1));
reg = eval_definition();
}else if (is_true(is_if(args_ref(1)))){
//eval if expression with the second argument (tail_context)
reg = args_ref(1);
args_push(args_ref(2));
args_push(reg);
reg = eval_if();
}else if (is_true(is_lambda(args_ref(1)))){
args_push(args_ref(1));
reg = eval_lambda();
}else if (is_true(is_begin(args_ref(1)))){
args_push(args_ref(1));
reg = begin_actions();
//eval the actions of begin exp with the second argument (tail_context)
args_push(args_ref(2));
args_push(reg);
reg = eval_sequence();
}else if (is_true(is_cond(args_ref(1)))){
args_push(args_ref(1));
reg = cond_2_if();
//eval the exp with the second argument (tail_context)
args_push(args_ref(2));
args_push(reg);
reg = eval();
}else if (is_true(is_and(args_ref(1)))){
reg = args_ref(1);
args_push(args_ref(2));
args_push(reg);
reg = eval_and();
}else if (is_true(is_or(args_ref(1)))){
reg = args_ref(1);
args_push(args_ref(2));
args_push(reg);
reg = eval_or();
}else if (is_true(is_let(args_ref(1)))){
//convert let to combination
args_push(args_ref(1));
reg = let_2_combination();
//evals the combination
args_push(args_ref(2));
args_push(reg);
reg = eval();
}else if (is_true(is_letstar(args_ref(1)))){
//convert let* to nested lets
args_push(args_ref(1));
reg = letstar_2_nested_lets();
//evals the nested lets
args_push(args_ref(2));
args_push(reg);
reg = eval();
}else if (is_true(is_application(args_ref(1)))){
//computes operator
args_push(args_ref(1));
reg = operator();
args_push(a_false);
args_push(reg);
reg = eval();
stack_push(&vars_stack, reg);
//computes operands
args_push(args_ref(1));
reg = operands();
args_push(reg);
reg = list_of_values();
//calls apply with the second argument (tail_context)
args_push(args_ref(2));
args_push(reg);
args_push(stack_pop(&vars_stack));
reg = apply();
}else {
printf("Unknown expression type -- EVAL\n");
error_handler();
}
args_pop(2);
return reg;
}