/*
* Name: parse_macro
* Purpose: separate literals from keys in a macro definition
* Date: June 5, 1992
* Passed: macro_key: key that we are a assigning a macro to
* residue: pointer to macro defs
* Notes: for each token in macro def, find out if it's a literal or a
* function key.
* a literal begins with a ". to put a " in a macro def, precede
* a " with a ".
*/
void parse_macro( int macro_key, char *residue )
{
int rc;
char literal[1042];
char *l;
int key_no;
/*
* reset any previous macro def.
*/
initialize_macro( macro_key );
while (residue != NULL) {
/*
* skip over any leading spaces.
*/
while (*residue == ' ')
++residue;
/*
* done if we hit a comment
*/
if (*residue == ';')
residue = NULL;
/*
* check for a literal.
*/
else if (*residue == '\"') {
rc = parse_literal( macro_key, residue, literal, &residue );
if (rc == OK) {
l = literal;
while (*l != '\0' && rc == OK) {
rc = record_keys( macro_key, *l );
++l;
}
} else {
printf( "==> %s", line_in );
printf( "Literal not recognized: line %u : literal %s\n", line_no, literal );
}
/*
* check for a function key.
*/
} else {
residue = parse_token( residue, literal );
key_no = search( literal, valid_keys, AVAIL_KEYS );
if (key_no != ERROR)
record_keys( macro_key, key_no+256 );
else {
printf( "==> %s", line_in );
printf( "Unrecognized key: line %u : key %s\n", line_no, literal );
}
}
}
check_macro( macro_key );
}
virtual expr check_type(expr const & m, abstract_type_context & ctx, bool infer_only) const {
check_macro(m);
expr given_type = macro_arg(m, 0);
if (!infer_only) {
ctx.check(given_type, infer_only);
expr inferred_type = ctx.check(macro_arg(m, 1), infer_only);
if (!ctx.is_def_eq(inferred_type, given_type)) {
throw_kernel_exception(ctx.env(), m, [=](formatter const & fmt) {
return format("type mismatch at term") + pp_type_mismatch(fmt, macro_arg(m, 1), inferred_type, given_type);
});
}
}
return given_type;
}
virtual expr check_type(expr const & m, abstract_type_context & ctx, bool infer_only) const {
check_macro(m);
environment const & env = ctx.env();
expr s = macro_arg(m, 0);
expr s_t = ctx.whnf(ctx.check(s, infer_only));
buffer<expr> I_args;
expr const & I = get_app_args(s_t, I_args);
if (!is_constant(I)) {
// remark: this is not an issue since this macro should not be used during elaboration.
throw_kernel_exception(env, sstream() << "projection macros do not support arbitrary terms "
<< "containing metavariables yet (solution: use trust-level 0)", m);
}
if (length(const_levels(I)) != length(m_ps))
throw_kernel_exception(env, sstream() << "invalid projection application '" << m_proj_name
<< "', incorrect number of universe parameters", m);
expr t = instantiate_univ_params(m_type, m_ps, const_levels(I));
I_args.push_back(s);
return instantiate_rev(t, I_args.size(), I_args.data());
}
virtual optional<expr> expand(expr const & m, abstract_type_context & ctx) const {
check_macro(m);
expr const & s = macro_arg(m, 0);
expr new_s = ctx.whnf(s);
buffer<expr> c_args;
expr const & c = get_app_args(new_s, c_args);
if (is_constant(c) && const_name(c) == m_constructor_name && m_idx < c_args.size()) {
return some_expr(c_args[m_idx]);
} else {
// expand into recursor
expr s_type = ctx.whnf(ctx.infer(s));
buffer<expr> args;
expr const & I = get_app_args(s_type, args);
if (!is_constant(I) || length(m_ps) != length(const_levels(I)))
return none_expr();
expr r = instantiate_univ_params(m_val, m_ps, const_levels(I));
args.push_back(new_s);
return some(instantiate_rev(r, args.size(), args.data()));
}
}
virtual pair<expr, constraint_seq> check_type(expr const & m, extension_context & ctx, bool infer_only) const {
constraint_seq cseq;
check_macro(m);
expr given_type = macro_arg(m, 0);
if (!infer_only) {
cseq += ctx.check_type(given_type, infer_only).second;
auto p = ctx.check_type(macro_arg(m, 1), infer_only);
expr inferred_type = p.first;
cseq += p.second;
justification jst = mk_type_mismatch_jst(macro_arg(m, 1), inferred_type, given_type, m);
as_delayed_justification djst(jst);
if (!ctx.is_def_eq(inferred_type, given_type, djst, cseq)) {
throw_kernel_exception(ctx.env(), m,
[=](formatter const & fmt) {
return pp_type_mismatch(fmt, macro_arg(m, 1), inferred_type, given_type);
});
}
}
return mk_pair(given_type, cseq);
}
virtual optional<expr> expand(expr const & m, extension_context &) const {
check_macro(m);
return some_expr(macro_arg(m, 1));
}
virtual pair<expr, constraint_seq> check_type(expr const & m, extension_context & ctx, bool infer_only) const {
check_macro(m);
return ctx.check_type(macro_arg(m, 1), infer_only);
}
virtual optional<expr> expand(expr const & m, abstract_type_context &) const {
check_macro(m);
return some_expr(macro_arg(m, 1));
}