SExpr* ProtoInterpreter::expand_macro(MacroOperator* m, SE_List* call) { Env m_env(this); // bind variables to SExprs if(!m->signature->legal_length(call->len()-1)) return sexp_err(call,"Wrong number of arguments for macro "+m->name); int i=1; // start after macro name for(int j=0;j<m->signature->required_inputs.size();j++) { ProtoSymbol* var = &dynamic_cast<ProtoSymbol &>(*m->signature->required_inputs[j]); m_env.bind(var->value,(*call)[i++]); } for(int j=0;j<m->signature->optional_inputs.size() && i<call->len();j++) { ProtoSymbol* var = &dynamic_cast<ProtoSymbol &>(*m->signature->optional_inputs[j]); m_env.bind(var->value,(*call)[i++]); } if(m->signature->rest_input) { // sweep all else into rest argument ProtoSymbol* var = &dynamic_cast<ProtoSymbol &>(*m->signature->rest_input); SE_List *rest = new SE_List(); rest->inherit_attributes(m); for(; i<call->len(); ) { rest->add((*call)[i++]); } m_env.bind(var->value,rest); } // then substitute the pattern V3 << "Expand macro call:\n"; V3 << call->to_str() << endl; SExpr* expanded = macro_substitute(m->pattern,&m_env); V3 << "Macro expanded into:\n"; V3 << expanded->to_str() << endl; return expanded; }
// Parse the extra arguments of a primitive into attributes void parse_primitive_attributes(SE_List_iter* li,Primitive* p) { while(li->has_next()) { SExpr* v = li->get_next(); if(!v->isKeyword()) {compile_error(v,v->to_str()+" not a keyword"); return;} const string &name = dynamic_cast<SE_Symbol &>(*v).name; if(p->attributes.count(name)) compile_warn("Primitive "+p->name+" overriding duplicate '" +name+"' attribute"); if(li->has_next() && !li->peek_next()->isKeyword()) { p->attributes[name]=new SExprAttribute(li->get_next()); } else { p->attributes[name]=new MarkerAttribute(true); } } }
// returns the output field Field* ProtoInterpreter::sexp_to_graph(SExpr* s, AM* space, Env *env) { V3 << "Interpret: " << ce2s(s) << " in " << ce2s(space) << endl; if(s->isSymbol()) { // All other symbols are looked up in the environment CompilationElement* elt = env->lookup(dynamic_cast<SE_Symbol &>(*s).name); if(elt==NULL) { V4 << "Symbolic literal?\n"; ProtoType* val = symbolic_literal(dynamic_cast<SE_Symbol &>(*s).name); if(val) { V4 << "- Yes\n"; return dfg->add_literal(val,space,s); } return field_err(s,space,"Couldn't find definition of "+s->to_str()); } else if(elt->isA("Field")) { V4 << "Found field: " << ce2s(elt) << endl; Field* f = &dynamic_cast<Field &>(*elt); if(f->domain==space) { return f; } if(f->domain->child_of(space)) { ierror(s,"Direct reference to child space in parent:"+ce2s(s)); } else { // implicit restriction OI *oi = new OperatorInstance(s,Env::core_op("restrict"),space); oi->add_input(f); if(space->selector) oi->add_input(space->selector); return oi->output; } } else if(elt->isA("Operator")) { V4 << "Lambda literal: " << ce2s(elt) << endl; return dfg->add_literal(new ProtoLambda(&dynamic_cast<Operator &>(*elt)), space, s); } else if(elt->isA("MacroSymbol")) { V4 << "Macro: " << ce2s(elt) << endl; return sexp_to_graph(dynamic_cast<MacroSymbol &>(*elt).pattern,space,env); } else return field_err(s,space,"Can't interpret "+elt->type_of()+" "+ s->to_str()+" as field"); } else if(s->isScalar()) { // Numbers are literals V4 << "Numeric literal.\n"; return dfg->add_literal(new ProtoScalar(dynamic_cast<SE_Scalar &>(*s).value), space,s); } else { // it must be a list // Lists are special forms or function applicatios SE_List* sl = &dynamic_cast<SE_List &>(*s); if(sl->len()==0) return field_err(sl,space,"Expression has no members"); if(sl->op()->isSymbol()) { // check if it's a special form string opname = dynamic_cast<SE_Symbol &>(*sl->op()).name; if(opname=="let") { return let_to_graph(sl,space,env,false); } else if(opname=="let*") { return let_to_graph(sl,space,env,true); } else if(opname=="all") { // evaluate children, returning last field Field* last=NULL; V4 << "Found 'all' construct\n"; for(int j=1;j<sl->len();j++) last = sexp_to_graph((*sl)[j],space,env); return last; } else if(opname=="restrict"){ return restrict_to_graph(sl,space,env); } else if(opname=="def" && sl->len()==3) { // variable definition SExpr *def=(*sl)[1], *exp=(*sl)[2]; if(!def->isSymbol()) return field_err(sl,space,"def name not a symbol: "+def->to_str()); Field* f = sexp_to_graph(exp,space,env); env->force_bind(dynamic_cast<SE_Symbol &>(*def).name,f); V4 << "Defined variable: " << ce2s(f) << endl; return f; } else if(opname=="def" || opname=="primitive" || opname=="lambda" || opname=="fun") { Operator* op = sexp_to_op(s,env); if(!(opname=="lambda" || opname=="fun")) return NULL; return dfg->add_literal(new ProtoLambda(op),space,s); } else if(opname=="annotate") { SE_List_iter li(sl); li.get_next(); // make iterator, discard op string name = li.get_token("operator name"); CE* p = env->lookup(name); if(p==NULL) { compile_error(sl,"Can't find primitve '"+name+"' to annotate"); } else if(!p->isA("Primitive")) { compile_error(sl,"Can't annotate '"+name+"': not a primitive"); } else { // add in attributes parse_primitive_attributes(&li, &dynamic_cast<Primitive &>(*p)); } return NULL; // annotations are like primitives: nothing returned } else if(opname=="letfed" || opname=="letfed+") { return letfed_to_graph(sl,space,env,opname=="letfed"); } else if(opname=="macro") { V4 << "Defining macro\n"; sexp_to_macro(sl,env); return NULL; } else if(opname=="include") { for(int j=1;j<sl->len();j++) { SExpr *ex = (*sl)[j]; V4 << "Including file: "<<ce2s(ex)<<endl; if(ex->isSymbol()) interpret_file(dynamic_cast<SE_Symbol &>(*ex).name); else compile_error(ex,"File name "+ex->to_str()+" is not a symbol"); } return NULL; } else if(opname=="quote") { if(sl->len()!=2) return field_err(sl,space,"Quote requires an argument: "+s->to_str()); V4 << "Creating quote literal\n"; return dfg->add_literal(quote_to_literal_type((*sl)[1]),space,s); } else if(opname=="quasiquote") { return field_err(sl,space,"Quasiquote only allowed in macros: "+sl->to_str()); } // check if it's a macro CompilationElement* ce = env->lookup(opname); if(ce && ce->isA("Macro")) { V4 << "Applying macro\n"; SExpr* new_expr; if(ce->isA("MacroOperator")) { new_expr = expand_macro(&dynamic_cast<MacroOperator &>(*ce),sl); if(new_expr->attributes.count("DUMMY")) // Mark of a failure return field_err(s,space,"Macro expansion failed on "+s->to_str()); } else { // it's a MacroSymbol new_expr = sl->copy(); dynamic_cast<SE_List &>(*new_expr).children[0] = dynamic_cast<Macro &>(*ce).pattern; } return sexp_to_graph(new_expr,space,env); } } // if we didn't return yet, it's an ordinary composite expression Operator *op = sexp_to_op(sl->op(),env); if(op->marked(":protected")) compile_warn(op,"operator '"+op->name+"' not intended for direct use."); OperatorInstance *oi = new OperatorInstance(s,op,space); for(vector<SExpr*>::iterator it=sl->args(); it!=sl->children.end(); it++) { Field* sub = sexp_to_graph(*it,space,env); // operator defs, primitives, and macros return null & are ignored if(sub) oi->add_input(sub); } if(!op->signature->legal_length(oi->inputs.size())) { compile_error(s,"Called "+ce2s(op)+" with "+i2s(oi->inputs.size())+ " arguments; it requires "+op->signature->num_arg_str()); } V4 << "Added operator "<<ce2s(oi)<<endl; return oi->output; } ierror("Fell through sexp_to_graph w/o returning for: "+s->to_str()); }
Field * ProtoInterpreter::letfed_to_graph(SE_List *s, AM *space, Env *env, bool init) { // Parse the input with the beautiful pattern matching language that // C++ affords us. if (! ((s->len() >= 3) & (*s)[1]->isList())) return field_err(s, space, "Malformed letfed expression: " + s->to_str()); vector<SExpr *>::const_iterator iterator = s->args(); SE_List *bindings = &dynamic_cast<SE_List &>(*(*iterator++)); size_t n = bindings->len(); vector<SExpr *> patterns; vector<SExpr *> initial_expressions; vector<SExpr *> update_expressions; for (size_t i = 0; i < n; i++) { SExpr *binding = (*bindings)[i]; if (!binding->isList()) compile_error(binding, "Malformed letfed binding: " + binding->to_str()); SE_List *binding_list = &dynamic_cast<SE_List &>(*binding); if (binding_list->len() != 3) compile_error(binding, "Malformed letfed binding: " + binding->to_str()); SExpr *pattern = (*binding_list)[0]; if (!letfed_pattern_p(pattern)) compile_error(pattern, "Malformed letfed pattern: " + pattern->to_str()); patterns.push_back(pattern); initial_expressions.push_back((*binding_list)[1]); update_expressions.push_back((*binding_list)[2]); } // Create the environments, conditional OIs, and subspaces. Env *body_env = new Env(env), *update_env = new Env(env); OI *true_if_change, *false_if_change; AM *initial_space, *update_space; if (init) { true_if_change = new OI(s, Env::core_op("dchange"), space); false_if_change = new OI(s, Env::core_op("not"), space); false_if_change->add_input(true_if_change->output); initial_space = new AM(s, space, true_if_change->output); update_space = new AM(s, space, false_if_change->output); } else { true_if_change = false_if_change = 0; initial_space = 0; update_space = space; } // Evaluate the initial expressions. vector<OI *> ois; for (size_t i = 0; i < n; i++) { SExpr *binding = (*bindings)[i]; SExpr *pattern = patterns[i]; SExpr *initial_expression = initial_expressions[i]; OI *delay = new OI(binding, Env::core_op("delay"), update_space); if (init) { OI *mux = new OI(binding, Env::core_op("mux"), space); mux->attributes["LETFED-MUX"] = new MarkerAttribute(true); mux->add_input(true_if_change->output); mux->add_input(sexp_to_graph(initial_expression, initial_space, env)); delay->add_input(mux->output); ois.push_back(mux); } else { delay->output->range = sexp_to_type(initial_expression); ois.push_back(delay); } // Bind the pattern variables to the delayed fields in the // environment for the update expression. bind_letfed_pattern(pattern, delay->output, update_space, update_env); } // Evaluate the update expressions. for (size_t i = 0; i < n; i++) { SExpr *binding = (*bindings)[i]; SExpr *pattern = patterns[i]; SExpr *update_expression = update_expressions[i]; Field *update = sexp_to_graph(update_expression, update_space, update_env); Field *field; if (init) field = ois[i]->output; else field = update; // Bind the pattern variables to the actual field in the body. bind_letfed_pattern(pattern, field, space, body_env); // Feed the update field back into the mux/delay OI. ois[i]->add_input(update); } // Evaluate the body. Field *field = 0; while (iterator != s->children.end()) field = sexp_to_graph(*iterator++, space, body_env); return field; }