static const char *NAME = "to_ada"; //===========================// //== This software is ==// //== (c)opyrighted in 1993 ==// //== by Chris Koeritz ==// //== cak0l@Virginia.EDU ==// //===========================// #include "help_yacc.h" #include "to_ada.h" #include "guards.h" #include "basics.h" #include "y.tab.h" #include "io_extend.h" #include "parse_zeno.h" #include "format_ada.h" #include #include #define DEBUG_TO_ADA // current_zeno_block: the current anonymous block number to issue to a new // block of Ada code. this number is used when the block has not been // explicitly labelled in the program. static int current_zeno_block = 0; // CONCLUSION_SYMBOL_NAME: the string beginning a ZENO conclusion in the symbol // table. #define CONCLUSION_SYMBOL_NAME "CONCLUSION:_" // UNRESOLVED_CONNECTION_SYMBOL_NAME: the string beginning the name of a // connection in the symbol table that has not yet been connected to the // continuation for the operation the connection belongs to. #define UNRESOLVED_CONNECTION_SYMBOL_NAME "UNRESOLVED_CONNECTION:_" // NAME_SEPARATOR: the character that separates names when they are combined // into a name for the symbol table. #define NAME_SEPARATOR "," // STUFF_ZENO_BIT: calls the class member function specified on the ZENO // object to be stored in the tree and passes to_stuff as the parameter to // the function. #define STUFF_ZENO_BIT(class_function, to_stuff) \ to_store->class_function(to_stuff) // GET_ZENO_KIND: assuming that the tree passed in has a zeno_contents, this // retrieves the kind of ZENO object held. #define GET_ZENO_KIND(get_from, variable_to_store_in, op_name) \ zeno_content_types variable_to_store_in; \ { tree_content *tc = (tree_content *)get_from->get_contents(); \ if (!tc->it_is_zeno()) \ parse_error(NAME, "GET_ZENO_KIND", op_name, \ "tree does not have a ZENO node", yylineno, \ yycurrent_position); \ zeno_contents *ozenoe; tc->get(ozenoe); \ variable_to_store_in = ozenoe->kind; } // ACCESS_ADA: pulls out the ada contents of a tree node. #define ACCESS_ADA(ada_tree, op_name) \ lang_contents *ada_cont; \ { tree_content *tc = (tree_content *)ada_tree->get_contents(); \ if (!tc->it_is_lang()) \ parse_error(NAME, "ACCESS_ADA", op_name, "not Ada contents", yylineno, \ yycurrent_position); \ tc->get(ada_cont); } // STUFF_ADA_BIT: inserts the part of the lang_contents specified into the // tree node being constructed by calling the class member function specified // and passing the ada bit as a parameter. #define STUFF_ADA_BIT(class_function, to_stuff) \ to_store->class_function(ada_cont->to_stuff) // MAKE_ZENO_TREE: creates the new zeno_contents to be stored into the tree and // puts it there. the place source is the tree from which to inherit a textual // position. #define MAKE_ZENO_TREE(ZCT_type, place_source, func_name) \ zeno_contents *zenoco = new zeno_contents; \ zenoco->kind = ZCT_type; \ zenoco->oprat = (operation *)to_store; \ zeno_tree *to_return = new zeno_tree; \ tree_content *tc = new tree_content(zenoco); \ to_return->set_contents(tc); \ to_return->set_place(place_source); \ if ( (ZCT_type != ZCT_CONCLUSION) && (ZCT_type != ZCT_CONNECTION) ) \ check_well_form(to_return, func_name); // RET: returns a zeno tree as created by the MAKE_ZENO_TREE macro. #define RET return to_return // MAKE_ADA_TREE: creates a ZENO tree with a content that holds a bit of ada. #define MAKE_ADA_TREE(toke, toketext, tree_to_create) \ zeno_tree *tree_to_create = new zeno_tree; \ { lang_contents *new_cont = new lang_contents; \ new_cont->token = toke; \ new_cont->token_text += toketext; \ tree_content *tc = new tree_content(new_cont); \ tree_to_create->set_contents(tc); } // CREATE_DESIRED_ZENO_BIT: creates a ZENO object of the specified type. // the object is always called to_store because it is intended to be the // returned object when each manipulation routine finishes. #define CREATE_DESIRED_ZENO_BIT(zeno_type) \ zeno_type *to_store = new zeno_type // ACCESS_ZENO: pulls the ZENO contents out of a tree. the zeno_type is the // object type to be created for storing the ZENO contents. the obj_to_find // is the type of ZENO object to look for in the tree. to_create // is the name for the zeno_type object specified. src_tree is the tree // to access the contents in. op_name is the name of the operation invoking // ACCESS_ZENO--it is used for reporting problems. #define ACCESS_ZENO(zeno_type, obj_to_find, to_create, src_tree, op_name) \ zeno_type *to_create; \ { tree_content *tc = (tree_content *)src_tree->get_contents(); \ if (!tc->it_is_zeno()) \ parse_error(NAME, "ACCESS_ZENO", op_name, "not ZENO contents", \ yylineno, yycurrent_position); \ zeno_contents *zeno_held; \ tc->get(zeno_held); \ if (zeno_held->kind != obj_to_find) \ parse_error(NAME, "ACCESS_ZENO", op_name, "incorrect token", \ yylineno, yycurrent_position); \ else to_create = (zeno_type *)zeno_held->oprat; } // MAKE_BRANCH_DESIRED: creates a pointer holding a needed branch. #define MAKE_BRANCH_DESIRED(tree_to_use, tree_to_create, branch_num) \ zeno_tree *tree_to_create; \ tree_to_create = (zeno_tree *)tree_to_use->branch(branch_num); // GRAND_BRANCH: creates a pointer holding the needed grandchild. #define GRAND_BRANCH(tree_to_use, tree_to_create, child_branch, gc_branch) \ MAKE_BRANCH_DESIRED(tree_to_use, intermed_tree, child_branch); \ MAKE_BRANCH_DESIRED(intermed_tree, tree_to_create, gc_branch); // B1, B2, ..., Bn: accesses the Ada contents of the nth branch in the tree // specified. #define B1(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 1); #define B2(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 2); #define B3(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 3); #define B4(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 4); #define B5(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 5); #define B6(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 6); #define B7(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 7); #define B8(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 8); #define B9(tree_src, to_create) MAKE_BRANCH_DESIRED(tree_src, to_create, 9); // B1_1, B1_2, ..., B2_1, B2_2, ..., Bx_y: accesses the grandchild of the tree. #define B1_1(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 1, 1); #define B1_2(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 1, 2); #define B1_3(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 1, 3); #define B1_4(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 1, 4); #define B2_1(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 2, 1); #define B2_2(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 2, 2); #define B2_3(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 2, 3); #define B2_4(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 2, 4); #define B3_1(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 3, 1); #define B3_2(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 3, 2); #define B3_3(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 3, 3); #define B3_4(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 3, 4); #define B4_1(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 4, 1); #define B4_2(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 4, 2); #define B4_3(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 4, 3); #define B4_4(tree_src, to_create) GRAND_BRANCH(tree_src, to_create, 4, 4); to_ada::to_ada(string file_name, symbol_tree *current_tables) { cout << "--! to_ada now parsing " << file_name << endl << flush; parse_only = FALSE; source_tree = current_tables; add_scope(file_name); redirect_input(file_name); string second_name(file_name); second_name += ".a"; redirect_output(second_name); last_token = 0; ZENO_OPENED = FALSE; yycurrent_position = 0; yylineno = 1; current_consequence_number = 1; } to_ada::~to_ada() { parse_only = FALSE; remove_scope(); fflush(stdout); redirect_input(NIL); redirect_output(NIL); current_zeno_block = -1; } tree_content *t_c(zeno_tree *zeno_object, string caller) { tree_content *tc = (tree_content *)zeno_object->get_contents(); if (!tc) parse_error (NAME, "t_c", caller, "source tree has no contents", yylineno, yycurrent_position); return tc; } int to_ada::parser_only() { return parse_only; } void to_ada::set_parser_only() { parse_only = TRUE; } symbol_tree *to_ada::symbols() { return source_tree; } void to_ada::check_well_form(zeno_tree *z_object, char *func_name) { if (parse_only) deadly_error(NAME, "check_well_form", "called for parser only"); tree_content *tc = t_c(z_object, "check_well_form"); string message; if (!tc->check_well_form(message)) parse_error (NAME, func_name, "check_well_form", message, tc->line_number, tc->character_position); } // consequence_spec: // consequence_head result_spec separator outcome_spec separator failure_spec zeno_tree *to_ada::add_consequence (zeno_tree *cons_name, zeno_tree *out_name, zeno_tree *res_name, ada_consequence_types ada_conseq_class) { if (parse_only) deadly_error(NAME, "add_consequence", "called for parser only"); CREATE_DESIRED_ZENO_BIT(consequence); ACCESS_ZENO(result, ZCT_RESULT, res, res_name, "add_consequence"); check_well_form(res_name, "add_consequence"); *(result *)to_store = *res; // STUFF_ZENO_BIT(result, res); ACCESS_ZENO(outcome, ZCT_OUTCOME, outc, out_name, "add_consequence"); check_well_form(out_name, "add_consequence"); *(outcome *)to_store = *outc; // STUFF_ZENO_BIT(outcome, outc); if (ada_conseq_class == FAILURE) { STUFF_ZENO_BIT(set_failure, TRUE); } MAKE_ZENO_TREE(ZCT_CONSEQUENCE, cons_name, "add_consequence"); RET; } // zeno_spec: ZENO_COMMENT operation_spec zeno_tree *to_ada::save_spec(zeno_tree *op_list) { if (parse_only) deadly_error(NAME, "save_spec", "called for parser only"); ACCESS_ZENO(operation, ZCT_OPERATION, op_to_store, op_list, "save_spec"); if (!op_to_store->well_formed()) parse_error(NAME, "save_spec", op_to_store->name(), "not well formed", t_c(op_list, "save_spec")->line_number, t_c(op_list, "save_spec")->character_position); current_info_unit->set_current_op(op_to_store); symbol_table::add_outcomes check = source_tree->add (op_to_store->name(), ZCT_OPERATION, op_to_store); if (check == symbol_table::EXISTING_SYMBOL) parse_error(NAME, "save_spec", op_to_store->name(), "already defined", t_c(op_list, "save_spec")->line_number, t_c(op_list, "save_spec")->character_position); return op_list; } // submerged_zeno: ZENO_COMMENT conclusion_indicator SEMICOLON zeno_tree *to_ada::add_conclusion(zeno_tree *indicator) { if (parse_only) deadly_error(NAME, "add_conclusion", "called for parser only"); CREATE_DESIRED_ZENO_BIT(conclusion); ACCESS_ADA(indicator, "add_conclusion"); if (ada_cont->token == IDENTIFIER) { STUFF_ADA_BIT(consequence_name, token_text); } else parse_error (NAME, "add_conclusion", ada_cont->token_text, "unknown conclusion indicator", t_c(indicator, "add_conclusion")->line_number, t_c(indicator, "add_conclusion")->character_position); MAKE_ZENO_TREE(ZCT_CONCLUSION, indicator, "add_conclusion"); rm(indicator); RET; } // connection: IDENTIFIER YIELDS IDENTIFIER zeno_tree *to_ada::add_connection(zeno_tree *op_name, zeno_tree *cons_name) { if (parse_only) deadly_error(NAME, "add_connection", "called for parser only"); CREATE_DESIRED_ZENO_BIT(connection); { ACCESS_ADA(op_name, "add_connection"); STUFF_ADA_BIT(yielder, token_text); } { ACCESS_ADA(cons_name, "add_connection"); STUFF_ADA_BIT(consequence_name, token_text); } MAKE_ZENO_TREE(ZCT_CONNECTION, op_name, "add_connection"); RET; } // submerged_zeno: // ZENO_COMMENT connection IMPLIES conclusion_indicator SEMICOLON zeno_tree *to_ada::add_connection_conclusion (zeno_tree *connect, zeno_tree *ret) { if (parse_only) deadly_error(NAME, "add_connection_conclusion", "called for parser only"); ACCESS_ZENO(connection, ZCT_CONNECTION, con, connect, "add_connection_conclusion"); ACCESS_ZENO(conclusion, ZCT_CONCLUSION, zenore, ret, "add_connection_conclusion"); con->connected_conclusion(zenore); connection *to_store = con; MAKE_ZENO_TREE(ZCT_CONNECTION, connect, "add_connection_conclusion"); rm(ret); RET; } // operation_spec: operation_head consequence_specs zeno_tree *to_ada::make_operation (zeno_tree *name, zeno_tree *consequence_specs) { if (parse_only) deadly_error(NAME, "make_operation", "called for parser only"); CREATE_DESIRED_ZENO_BIT(operation); ACCESS_ADA(name, "make_operation"); STUFF_ADA_BIT(name, token_text); for (int i = 1; i <= consequence_specs->branches(); i++) { MAKE_BRANCH_DESIRED(consequence_specs, cons_i, i); ACCESS_ZENO(consequence, ZCT_CONSEQUENCE, confound, cons_i, "make_operation"); to_store->add_consequence(confound); } MAKE_ZENO_TREE(ZCT_OPERATION, name, "make_operation"); RET; } // consequence_specs: consequence_spec consequence_specs zeno_tree *to_ada::add_consequences (zeno_tree *new_consequence, zeno_tree *conseq_list) { if (parse_only) deadly_error(NAME, "add_consequences", "called for parser only"); zeno_tree *to_return; if (conseq_list->branches() > 0) { conseq_list->attach(new_consequence); to_return = conseq_list; } else { to_return = new zeno_tree; to_return->attach(new_consequence); } // this might not be the right place to set the location to... to_return->set_place(conseq_list); return to_return; } // outcome_spec: OUTCOME IDENTIFIER WHEN_ outcome_preconditions zeno_tree *to_ada::add_outcome(zeno_tree *name, zeno_tree *preconditions) { if (parse_only) deadly_error(NAME, "add_outcome", "called for parser only"); CREATE_DESIRED_ZENO_BIT(outcome); ACCESS_ADA(name, "add_outcome"); STUFF_ADA_BIT(name, token_text); STUFF_ZENO_BIT(expression, preconditions); MAKE_ZENO_TREE(ZCT_OUTCOME, name, "add_outcome"); RET; } // result_spec: RESULT DEFINED_AS result_expression result_type_spec zeno_tree *to_ada::add_result (zeno_tree *characteristic_predicate, zeno_tree *type_spec) { if (parse_only) deadly_error(NAME, "add_result", "called for parser only"); CREATE_DESIRED_ZENO_BIT(result); STUFF_ZENO_BIT(expression, characteristic_predicate); string typename; if (t_c(type_spec, "add_result")->it_is_empty()) { if (characteristic_predicate->branches() != 0) { parse_error(NAME, "add_result", "result", "complex expression without type specified", yylineno, yycurrent_position); } ACCESS_ADA(characteristic_predicate, "add_result"); string nilword("nil"); if (ada_cont->token_text != nilword) parse_error (NAME, "add_result", "result", "no type specified for non-Nil result", yylineno, yycurrent_position); typename += "nil"; } else { ACCESS_ADA(type_spec, "add_result"); typename += ada_cont->token_text; if (characteristic_predicate->branches() == 0) { ACCESS_ADA(characteristic_predicate, "add_result"); string nilword("nil"); if (ada_cont->token_text == nilword) parse_error (NAME, "add_result", "result", "has Nil type, but has expression specified", yylineno, yycurrent_position); } } STUFF_ZENO_BIT(type, typename); MAKE_ZENO_TREE(ZCT_RESULT, characteristic_predicate, "add_result"); RET; } // statement: ..label.. submerged_zeno simple_statement // | ..label.. submerged_zeno compound_statement zeno_tree *to_ada::connect_submerged_zeno (zeno_tree *specified_label, zeno_tree *submerged_zeno, zeno_tree *code_block) { if (parse_only) deadly_error(NAME, "connect_submerged_zeno", "called for parser only"); if (specified_label->branches() == 0) { // need to create a label. MAKE_ADA_TREE(L_LBL_, "<<", s1); string zeno_label("Anonymous_ZENO_block_%d", ++current_zeno_block); MAKE_ADA_TREE(IDENTIFIER, zeno_label, s2); MAKE_ADA_TREE(R_LBL_, ">>--", s3); specified_label->attach(s1); specified_label->attach(s2); specified_label->attach(s3); } // the label used for this block is retrieved. zeno_tree *label_held = (zeno_tree *)specified_label->branch(2); ACCESS_ADA(label_held, "connect_submerged_zeno"); // the connection is checked for its type. GET_ZENO_KIND(submerged_zeno, kindness, "connect_submerged_zeno"); if (kindness == ZCT_CONNECTION) { // a regular connection between an operation and its continuation. ACCESS_ZENO(connection, ZCT_CONNECTION, zenocon, submerged_zeno, "connect_submerged_zeno"); zenocon->block(ada_cont->token_text); if (!zenocon->link()) zenocon->link(stuff(specified_label, code_block)); else cout << "zeno con link was set in connect_sub_zeno!\n" << flush; #ifdef DEBUG_TO_ADA cout << "link place in connection connect_submerged_zeno:\n" << flush; zenocon->link()->print(); #endif string connection_name ("%s%s%s%s", UNRESOLVED_CONNECTION_SYMBOL_NAME, (char *)zenocon->yielder(), NAME_SEPARATOR, (char *)zenocon->consequence_name()); check_well_form(submerged_zeno, "connect_submerged_zeno"); #ifdef DEBUG_TO_ADA cout << "finding " << connection_name << endl << flush; #endif symbol_table *symbols = source_tree->current_table(); int sym_type = 0; chunk *sym_content; int index = 0; symbol_table::find_outcomes found = symbols->partial_match(connection_name, index); connection *zenocon_found = NIL; if (found == symbol_table::FOUND) { sym_type = symbols->symbol_type(index); sym_content = (chunk *)(*symbols)[index]; zenocon_found = (connection *)sym_content; if (!zenocon_found->link()) { cout << "link is nil!\n" << flush; } // string temp_name; // temp_name = symbols.symbol_name(index); // // the last comma is being located in the symbol name found. // int check_position = temp_name.length() - 1; // char to_find = NAME_SEPARATOR[0]; // while ( (check_position > 0) // && (temp_name.find_char(to_find, check_position) == -1) ) { // check_position--; // } // if (!check_position || // (temp_name.find_char(to_find, check_position) != check_position)) // deadly_error(NAME, "connect_submerged_zeno", // "bad connection name in table"); // string num_part(temp_name); // num_part.kill(0, check_position); // int num_found = 0; // int line_found = sscanf(num_part, "%d", &num_found); // if (num_found < t_c(submerged_zeno, "connect_submerged_zeno") // ->line_number) { //cout << "connecting up to one that was less....\n" << flush; // if (!zenocon_found->link()) // zenocon_found->link(zenocon->link()); // else cout << "zeno con link was set in connect_sub_zeno special!\n" << flush; // } } else parse_error (NAME, "connect_submerged_zeno", connection_name, "not found", t_c(submerged_zeno, "connect_submerged_zeno")->line_number, t_c(submerged_zeno, "connect_submerged_zeno")->character_position); #ifdef DEBUG_TO_ADA cout << "before resolve, sym table is:\n" << flush; symbols->print(); #endif resolve_connection(zenocon, zenocon_found); if (symbols->kill(index) == symbol_table::NOT_IN_TABLE) deadly_error(NAME, "connect_submerged_zeno", "symbol table error: kill cannot find"); cout << "---------------------------------------------------------\n" << flush; return zenocon->link(); } else if (kindness == ZCT_CONCLUSION) { // a submerged ZENO conclusion. ACCESS_ZENO(conclusion, ZCT_CONCLUSION, zenoret, submerged_zeno, "connect_submerged_zeno"); string ret_name(CONCLUSION_SYMBOL_NAME); if (zenoret->consequence_name().length() == 0) parse_error (NAME, "connect_submerged_zeno", "conclusion", "name not specified", t_c(submerged_zeno, "connect_submerged_zeno")->line_number, t_c(submerged_zeno, "connect_submerged_zeno")->character_position); else ret_name += zenoret->consequence_name(); if (!zenoret->link()) zenoret->link(stuff(specified_label, code_block)); else cout << "zeno ret link was set in connect_sub_zeno!\n" << flush; cout << "link place in conclusion connect_submerged_zeno:\n" << flush; zenoret->link()->print(); source_tree->add(ret_name, ZCT_CONCLUSION, zenoret); check_well_form(submerged_zeno, "connect_submerged_zeno"); cout << "---------------------------------------------------------\n" << flush; return zenoret->link(); } else parse_error (NAME, "connect_submerged_zeno", "submerged_zeno", "unknown ZENO contents", t_c(submerged_zeno, "connect_submerged_zeno")->line_number, t_c(submerged_zeno, "connect_submerged_zeno")->character_position); } zeno_tree *to_ada::create_consequence_type(zeno_tree *zeno_spec) { if (parse_only) deadly_error(NAME, "create_consequence_type", "called for parser only"); ACCESS_ZENO(operation, ZCT_OPERATION, op_def, zeno_spec, "create_consequence_type"); zeno_tree *to_return = new zeno_tree; // create: // type _outcomes is (outcome1, ..., outcomeN); string outname(op_def->name()); // name for enumerated outcome type. { MAKE_ADA_TREE(TYPE_, "type", tspec); outname += "_outcomes"; MAKE_ADA_TREE(IDENTIFIER, outname, outtypename); MAKE_ADA_TREE(IS_, "is", isword); MAKE_ADA_TREE(LEFT_PAREN, "(", lparen); zeno_tree *enum_type_def = stuff(tspec, outtypename, isword, lparen); for (int i = 0; i < op_def->consequences(); i++) { consequence *coni = op_def->get_consequence(i); string conname(coni->outcome::name()); MAKE_ADA_TREE(IDENTIFIER, conname, new_word); enum_type_def->attach(new_word); if (i != op_def->consequences()-1) { MAKE_ADA_TREE(COMMA, ",", comma); enum_type_def->attach(comma); } } MAKE_ADA_TREE(RIGHT_PAREN, ")", rparen); enum_type_def->attach(rparen); MAKE_ADA_TREE(SEMICOLON, ";--", semitend); enum_type_def->attach(semitend); to_return->attach(enum_type_def); } // create: // type _results is record // result_1 : ; // result_ : ; // end record; // (since variant records in ada are statically declared, they cannot be used // in a subprogram that does not know what one of the contents will be yet.) { // first, do the type _result is record MAKE_ADA_TREE(TYPE_, "type", opntype); string opnresname(op_def->name()); opnresname += "_result"; MAKE_ADA_TREE(IDENTIFIER, opnresname, resnamer); MAKE_ADA_TREE(IS_, "is", isit); MAKE_ADA_TREE(RECORD_, "record--", recopro); to_return->attach(stuff(opntype, resnamer, isit, recopro)); } string nilword("nil"); { // add results for each outcome with a non-nil result. for (int i = 0; i < op_def->consequences(); i++) { consequence *coni = op_def->get_consequence(i); if (coni->type() != nilword) { string results_name("result_%d", i + 1); MAKE_ADA_TREE(IDENTIFIER, results_name, resnam); MAKE_ADA_TREE(COLON, ":", colnam); MAKE_ADA_TREE(IDENTIFIER, coni->type(), typnam); MAKE_ADA_TREE(SEMICOLON, ";--", seminam); to_return->attach(stuff(resnam, colnam, typnam, seminam)); } } } { // end of record statement. MAKE_ADA_TREE(END_, "end", endwo); MAKE_ADA_TREE(RECORD_, "record", recwo); MAKE_ADA_TREE(SEMICOLON, ";--", semi); to_return->attach(stuff(endwo, recwo, semi)); } // create: // type _consequence is record // outcome : _outcomes; // result : _results; // end record; { // type part of it. MAKE_ADA_TREE(TYPE_, "type", tspec); string typename(op_def->name()); typename += "_consequence"; MAKE_ADA_TREE(IDENTIFIER, typename, tname); MAKE_ADA_TREE(IS_, "is", isword); MAKE_ADA_TREE(RECORD_, "record--", recword); to_return->attach(stuff(tspec, tname, isword, recword)); } { // outcome part of it. MAKE_ADA_TREE(IDENTIFIER, "outcome", outword); MAKE_ADA_TREE(COLON, ":", colword); MAKE_ADA_TREE(IDENTIFIER, outname, outtype); MAKE_ADA_TREE(SEMICOLON, ";--", semiolo); to_return->attach(stuff(outword, colword, outtype, semiolo)); } { // result part. MAKE_ADA_TREE(IDENTIFIER, "result", resword); MAKE_ADA_TREE(COLON, ":", col2word); string resname(op_def->name()); resname += "_results"; MAKE_ADA_TREE(IDENTIFIER, resname, outdeftype); MAKE_ADA_TREE(SEMICOLON, ";--", semiola); to_return->attach(stuff(resword, col2word, outdeftype, semiola)); } { // end of consequence def. MAKE_ADA_TREE(END_, "end", endbub); MAKE_ADA_TREE(RECORD_, "record", recend); MAKE_ADA_TREE(SEMICOLON, ";--", semiole); to_return->attach(stuff(endbub, recend, semiole)); } return to_return; } // subprg_declaration: zeno_spec subprg_spec SEMICOLON zeno_tree *to_ada::mangle_subprg_spec (zeno_tree *zeno_spec, zeno_tree *subprg_spec, int prepend_definition) { if (parse_only) deadly_error(NAME, "mangle_subprg_spec", "called for parser only"); B1(subprg_spec, header); ACCESS_ADA(header, "mangle_subprg_spec"); if (ada_cont->token == FUNCTION_) { // take care of warping it to a procedural form. B4(subprg_spec, retword); B5(subprg_spec, functype); subprg_spec->prune(4); subprg_spec->prune(5); rm(retword); } B2(subprg_spec, opname); // check whether this is actually an operation or not? B3(subprg_spec, formalpart); int had_specs_before = TRUE; if (formalpart->branches() == 0) { // deal with no contents at all. MAKE_ADA_TREE(LEFT_PAREN, "(", f1); MAKE_ADA_TREE(RIGHT_PAREN, ")", f2); formalpart->attach(f1); formalpart->attach(f2); had_specs_before = FALSE; } // add consequence part to formal part. { MAKE_ADA_TREE(IDENTIFIER, "consequence", e1); MAKE_ADA_TREE(COLON, ":", e2); MAKE_ADA_TREE(OUT_, "in out", e3); ACCESS_ADA(opname, "mangle_subprg_spec"); string typename(ada_cont->token_text); typename += "_consequence"; MAKE_ADA_TREE(IDENTIFIER, typename, e4); MAKE_ADA_TREE(SEMICOLON, ";", e5); formalpart->attach(2, e1); formalpart->attach(3, e2); formalpart->attach(4, e3); formalpart->attach(5, e4); if (had_specs_before) formalpart->attach(6, e5); else rm(e5); } // need to output the consequence type used in the operation. if (prepend_definition) { zeno_tree *consdef = create_consequence_type(zeno_spec); current_info_unit->add_to_prefixed_declarations(consdef); } return subprg_spec; } // subprg_body: zeno_spec real_subprg_body zeno_tree *to_ada::mangle_subprg_body (zeno_tree *zeno_spec, zeno_tree *subprg_body) { if (parse_only) deadly_error(NAME, "mangle_subprg_body", "called for parser only"); B1(subprg_body, subprg_spec); // the true below should be generated dependent upon scope. mangle_subprg_spec(zeno_spec, subprg_spec, TRUE); return patch_zeno_connections(zeno_spec, subprg_body); } void to_ada::set_up_conclusion(int symbol_index) { if (parse_only) deadly_error(NAME, "set_up_conclusion", "called for parser only"); symbol_table *symbols = source_tree->current_table(); conclusion *concluder = (conclusion *)(*symbols)[symbol_index]; // if the conclusion is before a raise statement, then the raise statement // is warped into a return statement with no expression (i.e., return;). // a typed result must have an expression, meaning it cannot be signified // with a raise statement. this error will be caught in the return mangling // block. B2_1(concluder->link(), conclusion_place); ACCESS_ADA(conclusion_place, "set_up_conclusion"); if (ada_cont->token == RAISE_) { // a raise statement to be mangled. ada_cont->token = RETURN_; string new_text("return"); ada_cont->token_text = new_text; B2(concluder->link(), raise_statement); if (raise_statement->branches() == 3) { B2(raise_statement, exception_name); raise_statement->prune(2); rm(exception_name); } } if (ada_cont->token != RETURN_) parse_error (NAME, "set_up_conclusion", ada_cont->token_text, "unknown ZENO conclusion usage", t_c(concluder->link(), "set_up_conclusion")->line_number, t_c(concluder->link(), "set_up_conclusion")->character_position); B2(concluder->link(), concluder_statement); // the first statement is created as: // consequence.outcome = ; { zeno_tree *first_statement; MAKE_ADA_TREE(IDENTIFIER, "consequence.outcome", outname); MAKE_ADA_TREE(EQUAL, "=", eqname); MAKE_ADA_TREE(IDENTIFIER, concluder->consequence_name(), opname); MAKE_ADA_TREE(SEMICOLON, ";--", seminam); first_statement = stuff(outname, eqname, opname, seminam); concluder_statement->attach(1, first_statement); } // the second statement is created as: // consequence.result = ; { zeno_tree *second_statement; B2_3(concluder->link(), expression_given); // the important checks being made with the conditional statements // are: 1. checking that a result requiring a typed result has one, // 2. if the compilation flag ENSURE_NIL_RESULTS_HAVE_EMPTY_EXPRESSIONS // is defined, then checking that a consequence with a Nil result does // not have an expression in the return statement. zeno_tree *expression_to_use = NIL; string nil_result("nil"); if (expression_given->branches() == 0) { // if there are no branches, then it is a simple expression like // Nil or 5. consequence *this_con = current_info_unit->current_op() ->get_consequence(concluder->consequence_name()); if (!this_con) parse_error (NAME, "set_up_conclusion", concluder->consequence_name(), "consequence specified for conclusion cannot be found", yylineno, yycurrent_position); if (this_con->type() != nil_result) { // if the result required for this consequence is not nil, then // the suitability of the return is checked. it must have a // non-"Nil" expression specified. ACCESS_ADA(expression_given, "set_up_conclusion"); if (ada_cont->token_text == nil_result) { parse_error (NAME, "set_up_conclusion", concluder->consequence_name(), "attempting to conclude with a Nil result for a\n\ consequence that requires a typed result", yylineno, yycurrent_position); } else { expression_to_use = expression_given; } } else { // nil results do not have a result setting statement. } } else { // the expression is a non-simple type. it is thus definitely not // specified as Nil. consequence *this_con = current_info_unit->current_op() ->get_consequence(concluder->consequence_name()); if (!this_con) parse_error (NAME, "set_up_conclusion", concluder->consequence_name(), "consequence specified for conclusion cannot be found", yylineno, yycurrent_position); #ifdef ENSURE_NIL_RESULTS_HAVE_EMPTY_RETURN_EXPRESSIONS if (this_con->type() == nil_result) parse_error (NAME, "set_up_conclusion", concluder->consequence_name(), "attempting to conclude with a typed result for a\n\ consequence that requires a Nil result", yylineno, yycurrent_position); #endif B2(concluder->link(), concluder_statement); concluder_statement->prune(3); expression_to_use = expression_given; } if (expression_to_use) { MAKE_ADA_TREE(IDENTIFIER, "consequence.result", resname); MAKE_ADA_TREE(EQUAL, "=", eqname); MAKE_ADA_TREE(SEMICOLON, ";--", seminam); second_statement = stuff(resname, eqname, expression_to_use, seminam); } else second_statement = new zeno_tree; concluder_statement->attach(2, second_statement); } } void to_ada::resolve_connection(connection *unresolved, connection *found) { if (parse_only) deadly_error(NAME, "resolve_connection", "called for parser only"); // jump_place: the pointer to the statement that needs to be linked // to the connection (jump_to label) in the source code. cout << "dumping found connection\n" << flush; found->print(); zeno_tree *jump_from = unresolved->link(); zeno_tree *jump_to = found->link(); cout << "resolving with jump_from being [" << flush; jump_from->print(); cout << "] and jump_to being [" << flush; jump_to->print(); cout << "]\n" << flush; { // zeno block label is extracted for the continuation. B1(jump_to, label_node); ACCESS_ADA(label_node, "resolve_connection"); string label_to_jump_to(ada_cont->token_text); // the unknown label is removed. B2(jump_from, intermediate); B2(intermediate, unknown_label); intermediate->prune(2); rm(unknown_label); MAKE_ADA_TREE(IDENTIFIER, label_to_jump_to, new_jump_label_node); intermediate->attach(2, new_jump_label_node); } } zeno_tree *to_ada::create_end_of_internal_frame() { if (parse_only) deadly_error(NAME, "create_end_of_internal_frame", "called for parser only"); zeno_tree *to_return = new zeno_tree; MAKE_ADA_TREE(END_, "end", end_word); to_return->attach(end_word); MAKE_ADA_TREE(SEMICOLON, ";--", semi); to_return->attach(semi); MAKE_ADA_TREE(EXCEPTION_, "exception--", exc); to_return->attach(exc); MAKE_ADA_TREE(WHEN_, "when", wheng); to_return->attach(wheng); MAKE_ADA_TREE(OTHERS_, "others", otho); to_return->attach(otho); MAKE_ADA_TREE(ARROW_, "=>--", auro); to_return->attach(auro); MAKE_ADA_TREE(IDENTIFIER, "consequence.outcome", cons_word); to_return->attach(cons_word); MAKE_ADA_TREE(EQUAL, "=", equo); to_return->attach(equo); return to_return; } zeno_tree *to_ada::create_end_of_external_frame() { if (parse_only) deadly_error (NAME, "create_end_of_external_frame", "called for parser only"); zeno_tree *to_return = new zeno_tree; MAKE_ADA_TREE(SEMICOLON, ";--", semi); to_return->attach(semi); MAKE_ADA_TREE(RETURN_, "return", ret_word); to_return->attach(ret_word); MAKE_ADA_TREE(SEMICOLON, ";--", semi2); to_return->attach(semi2); return to_return; } zeno_tree *to_ada::lookup_failure_consequence(operation *zeno_spec) { if (parse_only) deadly_error(NAME, "lookup_failure_consequence", "called for parser only"); int failure_found = -1; zeno_tree *to_return = NIL; for (int i = 0; i < zeno_spec->consequences(); i++) { consequence *coni = zeno_spec->get_consequence(i); if (coni->failure()) { if (failure_found >= 0) parse_error(NAME, "lookup_failure_consequence", zeno_spec->name(), "multiple consequences specified as failures", yylineno, yycurrent_position); else { failure_found = i; MAKE_ADA_TREE(IDENTIFIER, coni->outcome::name(), to_store); to_return = to_store; } } } return to_return; } zeno_tree *to_ada::create_operation_frame (operation *zeno_spec, zeno_tree *subprg_body) { if (parse_only) deadly_error(NAME, "create_operation_frame", "called for parser only"); // break up the current subprogram body into its parts. B1(subprg_body, subprg_spec); B2(subprg_body, is_word); B3(subprg_body, decls); B4(subprg_body, begin_word); B5(subprg_body, statements); B6(subprg_body, handlers); B7(subprg_body, end_word); B8(subprg_body, opname_end); B9(subprg_body, semicolon_word); B2(subprg_spec, opname); MAKE_ADA_TREE(DECLARE_, "declare--", decl_word); MAKE_ADA_TREE(BEGIN_, "begin--", begin2); { ACCESS_ADA(is_word, "create_operation_frame"); ada_cont->token_text += "--"; } { ACCESS_ADA(begin_word, "create_operation_frame"); ada_cont->token_text += "--"; } { ACCESS_ADA(semicolon_word, "create_operation_frame"); ada_cont->token_text += "--"; } subprg_body->attach(3, begin2); subprg_body->attach(4, decl_word); subprg_body->attach(8, create_end_of_internal_frame()); zeno_tree *failure_con = lookup_failure_consequence(zeno_spec); if (!failure_con) parse_error (NAME, "create_operation_frame", zeno_spec->name(), "has no failure consequence specified", t_c(subprg_body, "create_operation_frame")->line_number, t_c(subprg_body, "create_operation_frame")->character_position); subprg_body->attach(9, failure_con); subprg_body->attach(10, create_end_of_external_frame()); subprg_body->prune(handlers); if (t_c(opname_end, "create_operation_frame")->it_is_lang()) { ACCESS_ADA(opname, "create_operation_frame"); MAKE_ADA_TREE(IDENTIFIER, ada_cont->token_text, new_op_end); zeno_tree *tmp = opname_end; subprg_body->prune(opname_end); subprg_body->attach(12, new_op_end); rm(opname_end); } return subprg_body; } zeno_tree *to_ada::patch_zeno_connections (zeno_tree *zeno_spec, zeno_tree *subprg_body) { if (parse_only) deadly_error(NAME, "patch_zeno_connections", "called for parser only"); operation *to_use; if (!zeno_spec) { to_use = NIL; } else { ACCESS_ZENO(operation, ZCT_OPERATION, op_def, zeno_spec, "patch_zeno_connections"); to_use = op_def; } symbol_table *symbols = source_tree->current_table(); for (int i = 0; i < symbols->elements(); i++) { int symtype = symbols->symbol_type(i); switch (symtype) { case ZCT_CONCLUSION: set_up_conclusion(i); symbols->kill(i); i--; break; case ZCT_CONNECTION: // resolve_connection(i); break; case ZCT_OPERATION: // operation *op = (operation *)((*symbols)[i]); // if (current_op->name() == op->name()) { // need to back patch all of the connections!! // } default: {}; } } if (to_use) return create_operation_frame(to_use, subprg_body); else return subprg_body; } // simple_statement: name SEMICOLON zeno_tree *to_ada::mangle_possible_operation_name (zeno_tree *maybe_op_name, zeno_tree *semicolon) { if (parse_only) return stuff(maybe_op_name, semicolon); // if there is a complex tree form for the name, then it cannot be a simple // operation name before the parameters to the operation. or so we currently // believe. if (!current_info_unit->subprg_spec_seen()) return stuff(maybe_op_name, semicolon); else if (maybe_op_name->branches() != 2) return stuff(maybe_op_name, semicolon); B1(maybe_op_name, name_found); B2(maybe_op_name, aggregate); ACCESS_ADA(name_found, "mangle_possible_operation_name"); if (name_found->branches() != 0) return stuff(maybe_op_name, semicolon); stack sym_path; symbol_table::find_outcomes found = source_tree->find (ada_cont->token_text, symbol_tree::SEARCH_EXTERNAL, sym_path); if (found == symbol_table::NOT_IN_TABLE) return stuff(maybe_op_name, semicolon); else { cout << "point A in mangle poss op name\n" << flush; symbol_table *symbols = source_tree->get_table(sym_path); int sym_type = 0; const chunk *sym_content = symbols->find(ada_cont->token_text, sym_type, found); if (found == symbol_table::NOT_IN_TABLE) deadly_error (NAME, "mangle_possible_operation_name", "name not found in table"); operation *op_def = (operation *)sym_content; current_info_unit->increment_operations_applied(); rm(semicolon); if (sym_type != ZCT_OPERATION) parse_error (NAME, "mangle_possible_operation_name", ada_cont->token_text, "not listed in the symbol table as an operation", t_c(name_found, "mangle_possible_operation_name")->line_number, t_c(name_found, "mangle_possible_operation_name") ->character_position); string cons_name("consequence_%d", current_consequence_number); { // the consequence parameter is added to the operation invocation: // fred(x, z) becomes fred(consequence_, x, z); MAKE_ADA_TREE(IDENTIFIER, cons_name, contree); MAKE_ADA_TREE(COMMA, ",", comlink); aggregate->attach(2, stuff(contree, comlink)); current_consequence_number++; MAKE_ADA_TREE(SEMICOLON, ";--", seminst); aggregate->attach(seminst); } { // this bit of code needs to be put in decls area.... // consequence_ : _consequence; MAKE_ADA_TREE(IDENTIFIER, cons_name, contree); MAKE_ADA_TREE(COLON, ":", colonic); string cons_type(ada_cont->token_text); cons_type += "_consequence"; MAKE_ADA_TREE(IDENTIFIER, cons_type, typetree); MAKE_ADA_TREE(SEMICOLON, ";--", semo); current_info_unit->add_to_prefixed_declarations (stuff(contree, colonic, typetree, semo)); } { // case consequence_.outcome is // when => goto place; // etc... // end case; MAKE_ADA_TREE(CASE_, "case", caseo); string outnam(cons_name); outnam += ".outcome"; MAKE_ADA_TREE(IDENTIFIER, outnam, outnode); MAKE_ADA_TREE(IS_, "is--", isnod); aggregate->attach(stuff(caseo, outnode, isnod)); for (int i = 0; i < op_def->consequences(); i++) { MAKE_ADA_TREE(WHEN_, "when", whengle); consequence *fred = op_def->get_consequence(i); MAKE_ADA_TREE(IDENTIFIER, fred->outcome::name(), outnam); MAKE_ADA_TREE(ARROW_, "=>--", arrogenous); MAKE_ADA_TREE(GOTO_, "goto", gotogoto); MAKE_ADA_TREE(IDENTIFIER, "unknown", unkyherb); MAKE_ADA_TREE(SEMICOLON, ";--", bleen); aggregate->attach (stuff(whengle, outnam, arrogenous, gotogoto, unkyherb, bleen)); { // a connection location is stored in the symbol table. zeno_tree *link_place = (zeno_tree *)aggregate->branch(aggregate->branches()); string new_conn ("%s%s%s%s%s%d", UNRESOLVED_CONNECTION_SYMBOL_NAME, (char *)ada_cont->token_text, NAME_SEPARATOR, (char *)fred->outcome::name(), NAME_SEPARATOR, t_c(maybe_op_name, "connect_submerged_zeno")->line_number); cout << "new con name is " << new_conn << endl << flush; connection *to_store = new connection; to_store->yielder(ada_cont->token_text); to_store->consequence_name(fred->outcome::name()); if (!to_store->link()) to_store->link(link_place); else cout << "to_store was set in mangle_poss!\n" << flush; cout << "here is the link place in mangle_possible_operation_name:\n" << flush; to_store->link()->print(); symbol_table::add_outcomes didit = source_tree->add(new_conn, ZCT_CONNECTION, to_store); if (didit == symbol_table::EXISTING_SYMBOL) { cout << "existing=" << flush; maybe_op_name->print(); cout << endl << flush; } if (didit == symbol_table::EXISTING_SYMBOL) parse_error (NAME, "mangle_possible_operation_name", new_conn, "already listed in the symbol table--preprocessor error", t_c(name_found, "mangle_possible_operation_name")->line_number, t_c(name_found, "mangle_possible_operation_name") ->character_position); } } MAKE_ADA_TREE(END_, "end", endcaser); MAKE_ADA_TREE(CASE_, "case", casestop); MAKE_ADA_TREE(SEMICOLON, ";--", semiendy); aggregate->attach(stuff(endcaser, casestop, semiendy)); } // if used in an expression, expression needs to be modified to // access con_.result return stuff(name_found, aggregate); } } // subprg_body: real_subprg_body zeno_tree *to_ada::patch_zeno_user(zeno_tree *subprg_body) { if (parse_only) return subprg_body; if (!current_info_unit->operation_application_count()) return subprg_body; else { zeno_tree *fred = patch_zeno_connections(NIL, subprg_body); return fred; } } void to_ada::add_scope(string scope_name) { if (parse_only) return; source_tree->push_scope(scope_name); current_info_unit = create_info_unit(); } void to_ada::add_scope(zeno_tree *scope_name) { if (parse_only) return; ACCESS_ADA(scope_name, "add_scope"); add_scope(ada_cont->token_text); } // DEFAULT_INFO_NAME: the info_unit name in the symbol table, one per scope. #define DEFAULT_INFO_NAME "INFO_UNIT:_" void to_ada::remove_scope() { if (parse_only) return; string info_name(DEFAULT_INFO_NAME); { // locate the current info unit so it can be trashed. symbol_table::find_outcomes found = source_tree->current_table()->kill(info_name); if (found == symbol_table::NOT_IN_TABLE) deadly_error(NAME, "remove_scope", "current info unit not found"); } string scope_name = source_tree->current_name(); source_tree->pop_scope(); { string libname("library"); if (source_tree->current_name() == libname) { // the library has no info unit. current_info_unit = NIL; } else { // find the current_info_unit from the previous scope. int sym_type; symbol_table::find_outcomes found; chunk *sym_content = source_tree->find (info_name, symbol_tree::CURRENT_ONLY, sym_type, found); if (sym_type) {}; // compiler gag. if (found == symbol_table::NOT_IN_TABLE) deadly_error(NAME, "remove_scope", "parent info unit could not found"); current_info_unit = (info_unit *)sym_content; } } } info_unit *to_ada::create_info_unit() { info_unit *to_return = new info_unit; string info_name(DEFAULT_INFO_NAME); source_tree->add(info_name, 0, to_return); return to_return; } format_ada *formatter = NIL; static void print_function(tree *current_node) { tree_content *tc = (tree_content *)current_node->get_contents(); if (!tc) return; if (tc->it_is_lang()) { // dump a standard ada token out. lang_contents *the_contents; tc->get(the_contents); string to_show = formatter->format(the_contents->token, the_contents->token_text); cout << to_show << flush; } else if (tc->it_is_empty()) return; else if (tc->it_is_zeno()) { // a zeno bit has arrived here? deadly_error(NAME, "print_function", "ZENO is in tree still, somehow"); } else deadly_error(NAME, "print_function", "unknown tree content"); } void to_ada::format(zeno_tree *to_format) { formatter = new format_ada; to_format->apply(&print_function, tree::postfix); delete formatter; }