instr_iteratort::instr_iteratort(goto_functionst &gf) : func_it(gf.function_map.begin()), func_end(gf.function_map.end()) { while (!has_body(func_it, func_end) && func_end != func_it) ++func_it; if (has_body(func_it, func_end)) prog_it=func_it->second.body.instructions.begin(); }
OBJECT SearchSym(FULL_CHAR *str, int len) { register int rlen, sum; register FULL_CHAR *x, *y; OBJECT p, q, link, plink, entry; int s; debug2(DST, DDD, "SearchSym( %c..., %d )", str[0], len); hash(str, len, sum); rlen = len; entry = (OBJECT) &symtab[sum]; for( plink = Down(entry); plink != entry; plink = NextDown(plink) ) { Child(p, plink); if( rlen == length(p) ) { x = str; y = string(p); do; while( *x++ == *y++ && --rlen ); if( rlen == 0 ) { debug1(DST, DDD, " found %s", string(p)); s = scope_top; do { s--; for( link = Down(p); link != p; link = NextDown(link) ) { Child(q, link); { debugcond4(DST, DDD, enclosing(q) == scope[s], " !npars_only[s] = %s, !vis_only[s] = %s, body_ok[s] = %s, !ss = %s", bool(!npars_only[s]), bool(!vis_only[s]), bool(body_ok[s]), bool(!suppress_scope)); } if( enclosing(q) == scope[s] && (!npars_only[s] || type(q) == NPAR) && (!vis_only[s] || visible(q) || suppress_visible ) && (body_ok[s] || type(q)!=RPAR || !has_body(enclosing(q)) || suppress_visible ) && (!suppress_scope || StringEqual(string(p), KW_INCLUDE) || StringEqual(string(p), KW_SYSINCLUDE)) ) { debug3(DST, DD, "SearchSym returning %s %s%%%s", Image(type(q)), SymName(q), SymName(enclosing(q))); return q; } } } while( scope[s] != StartSym ); } } rlen = len; } debug0(DST, DDD, "SearchSym returning <nilobj>"); return nilobj; } /* end SearchSym */
Promise fetch() { auto request = Http::Request::get(get_url()); request->set_headers({{"Accept",Archive::mimetype}}); return request->send().then([this, request]() { auto response = request->get_response(); if (response->ok()) { if (response->has_body()) parse(response->get_response_text()); synced.trigger(); } }); }
OBJECT InsertSym(FULL_CHAR *str, unsigned char xtype, FILE_POS *xfpos, unsigned char xprecedence, BOOLEAN xindefinite, BOOLEAN xrecursive, unsigned xpredefined, OBJECT xenclosing, OBJECT xbody) { register int sum, rlen; register unsigned char *x; OBJECT p, q, s, tmp, link, entry, plink; int len; debug3(DST, DD, "InsertSym( %s, %s, in %s )", Image(xtype), str, SymName(xenclosing)); if( !LexLegalName(str) ) Error(29, 3, "invalid symbol name %s", WARN, xfpos, str); New(s, xtype); FposCopy(fpos(s), *xfpos); has_body(s) = FALSE; filter(s) = nilobj; use_invocation(s) = nilobj; imports(s) = nilobj; imports_encl(s) = FALSE; right_assoc(s) = TRUE; precedence(s) = xprecedence; indefinite(s) = xindefinite; recursive(s) = xrecursive; predefined(s) = xpredefined; enclosing(s) = xenclosing; sym_body(s) = xbody; base_uses(s) = nilobj; uses(s) = nilobj; marker(s) = nilobj; cross_sym(s) = nilobj; is_extern_target(s) = FALSE; uses_extern_target(s)= FALSE; visible(s) = FALSE; uses_galley(s) = FALSE; horiz_galley(s) = ROWM; has_compulsory(s) = 0; is_compulsory(s) = FALSE; uses_count(s) = 0; dirty(s) = FALSE; if( enclosing(s) != nilobj && type(enclosing(s)) == NPAR ) dirty(s) = dirty(enclosing(s)) = TRUE; has_par(s) = FALSE; has_lpar(s) = FALSE; has_rpar(s) = FALSE; if( is_par(type(s)) ) has_par(enclosing(s)) = TRUE; if( type(s) == LPAR ) has_lpar(enclosing(s)) = TRUE; if( type(s) == RPAR ) has_rpar(enclosing(s)) = TRUE; /* assign a code letter between a and z to any NPAR symbol */ if( type(s) == NPAR ) { if( LastDown(enclosing(s)) != enclosing(s) ) { Child(tmp, LastDown(enclosing(s))); if( type(tmp) == NPAR ) { if( npar_code(tmp) == 'z' || npar_code(tmp) == ' ' ) npar_code(s) = ' '; else npar_code(s) = npar_code(tmp)+1; } else npar_code(s) = 'a'; } else npar_code(s) = 'a'; } has_target(s) = FALSE; force_target(s) = FALSE; if( !StringEqual(str, KW_TARGET) ) is_target(s) = FALSE; else { is_target(s) = has_target(enclosing(s)) = TRUE; /* if @Target is found after @Key, take note of external target */ if( has_key(enclosing(s)) && xbody != nilobj && is_cross(type(xbody)) ) { if( LastDown(xbody) != Down(xbody) ) { OBJECT sym; Child(sym, Down(xbody)); if( type(sym) == CLOSURE ) { is_extern_target(actual(sym)) = TRUE; uses_extern_target(actual(sym)) = TRUE; } } } } has_tag(s) = is_tag(s) = FALSE; has_key(s) = is_key(s) = FALSE; has_optimize(s) = is_optimize(s) = FALSE; has_merge(s) = is_merge(s) = FALSE; has_enclose(s) = is_enclose(s) = FALSE; if( enclosing(s) != nilobj && type(enclosing(s)) == LOCAL ) { if( StringEqual(str, KW_TAG) ) is_tag(s) = has_tag(enclosing(s)) = dirty(enclosing(s)) = TRUE; if( StringEqual(str, KW_OPTIMIZE) ) is_optimize(s) = has_optimize(enclosing(s)) = TRUE; if( StringEqual(str, KW_KEY) ) { is_key(s) = has_key(enclosing(s)) = dirty(enclosing(s)) = TRUE; /* if @Key is found after @Target, take note of external target */ for( link=Down(enclosing(s)); link!=enclosing(s); link=NextDown(link) ) { Child(p, link); if( is_target(p) && sym_body(p)!=nilobj && is_cross(type(sym_body(p))) ) { OBJECT sym; Child(sym, Down(sym_body(p))); if( type(sym) == CLOSURE ) { is_extern_target(actual(sym)) = TRUE; uses_extern_target(actual(sym)) = TRUE; } } } } if( StringEqual(str, KW_MERGE) ) is_merge(s) = has_merge(enclosing(s)) = TRUE; if( StringEqual(str, KW_ENCLOSE) ) is_enclose(s) = has_enclose(enclosing(s)) = TRUE; } if( StringEqual(str, KW_FILTER) ) { if( type(s) != LOCAL || enclosing(s) == StartSym ) Error(29, 4, "%s must be a local definition", WARN, &fpos(s), str); else if( !has_rpar(enclosing(s)) ) Error(29, 14, "%s must lie within a symbol with a right parameter", WARN, &fpos(s), KW_FILTER); else { filter(enclosing(s)) = s; precedence(enclosing(s)) = FILTER_PREC; } } if( type(s) == RPAR && has_body(enclosing(s)) && (is_tag(s) || is_key(s) || is_optimize(s)) ) Error(29, 5, "a body parameter may not be named %s", WARN, &fpos(s), str); if( type(s) == RPAR && has_target(enclosing(s)) && (is_tag(s) || is_key(s) || is_optimize(s)) ) Error(29, 6, "the right parameter of a galley may not be called %s", WARN, &fpos(s), str); len = StringLength(str); hash(str, len, sum); ifdebug(DST, D, sym_spread[sum]++; sym_count++); entry = (OBJECT) &symtab[sum]; for( plink = Down(entry); plink != entry; plink = NextDown(plink) ) { Child(p, plink); if( length(p) == len && StringEqual(str, string(p)) ) { for( link = Down(p); link != p; link = NextDown(link) ) { Child(q, link); if( enclosing(s) == enclosing(q) ) { Error(29, 7, "symbol %s previously defined at%s", WARN, &fpos(s), str, EchoFilePos(&fpos(q)) ); if( AltErrorFormat ) { Error(29, 13, "symbol %s previously defined here", WARN, &fpos(q), str); } break; } } goto wrapup; } } /* need a new OBJECT as well as s */ NewWord(p, WORD, len, xfpos); length(p) = len; StringCopy(string(p), str); Link(entry, p); wrapup: Link(p, s); if( enclosing(s) != nilobj ) Link(enclosing(s), s); debug2(DST, DD, "InsertSym Link(%s, %s) and returning.", SymName(enclosing(s)), SymName(s)); return s; } /* end InsertSym */
void ReadDefinitions(OBJECT *token, OBJECT encl, unsigned char res_type) { OBJECT t, res, res_target, export_list, import_list, link, y, z; OBJECT curr_encl; BOOLEAN compulsory_par, has_import_encl; t = *token; while( res_type==LOCAL || is_string(t, KW_NAMED) || is_string(t, KW_IMPORT) ) { curr_encl = encl; if( is_string(t, KW_LANGDEF) ) { ReadLangDef(encl); t = LexGetToken(); continue; /* next definition */ } else if( type(t) == PREPEND || type(t) == SYS_PREPEND ) { ReadPrependDef(type(t), encl); Dispose(t); t = LexGetToken(); continue; /* next definition */ } else if( type(t) == INCG_REPEATED || type(t) == SINCG_REPEATED ) { ReadIncGRepeatedDef(type(t), encl); Dispose(t); t = LexGetToken(); continue; /* next definition */ } else if( type(t) == DATABASE || type(t) == SYS_DATABASE ) { ReadDatabaseDef(type(t), encl); Dispose(t); t = LexGetToken(); continue; /* next definition */ } if( !is_string(t, KW_DEF) && !is_string(t, KW_MACRO) && !is_string(t, KW_NAMED) && !is_string(t, KW_IMPORT) && !is_string(t, KW_EXTEND) && !is_string(t, KW_EXPORT) ) break; /* get import or extend list and change scope appropriately */ BodyParNotAllowed(); New(import_list, ACAT); has_import_encl = FALSE; if( is_string(t, KW_IMPORT) ) { Dispose(t); t = LexGetToken(); while( type(t) == CLOSURE || (type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF) && !is_string(t, KW_MACRO) && !is_string(t, KW_NAMED)) ) { if( type(t) == CLOSURE ) { if( type(actual(t)) == LOCAL ) { /* *** letting this through now if( res_type == NPAR && has_par(actual(t)) ) { Error(5, 46, "named parameter import %s has parameters", WARN, &fpos(t), SymName(actual(t))); } else { *** */ PushScope(actual(t), FALSE, TRUE); if( actual(t) == encl ) has_import_encl = TRUE; Link(import_list, t); /* *** } *** */ } else { Error(5, 26, "import name expected here", WARN, &fpos(t)); Dispose(t); } } else { Error(5, 27, "import %s not in scope", WARN, &fpos(t), string(t)); Dispose(t); } t = LexGetToken(); } } else if( is_string(t, KW_EXTEND) ) { Dispose(t); t = LexGetToken(); while( type(t) == CLOSURE || (type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF) && !is_string(t, KW_MACRO)) ) { if( type(t) == CLOSURE ) { if( imports(actual(t)) != nilobj ) { Error(5, 48, "%s has %s clause, so cannot be extended", WARN, &fpos(t), SymName(actual(t)), KW_IMPORT); } else if( type(actual(t)) == LOCAL ) { PushScope(actual(t), FALSE, FALSE); curr_encl = actual(t); debug1(DRD, D, " curr_encl = %s", SymName(curr_encl)); Link(import_list, t); } else { Error(5, 28, "%s symbol name expected here", WARN, &fpos(t), KW_EXTEND); Dispose(t); } } else { Error(5, 29, "extend symbol %s not in scope", WARN,&fpos(t),string(t)); Dispose(t); } t = LexGetToken(); } } /* get export list and store for setting visible flags below */ New(export_list, ACAT); if( is_string(t, KW_EXPORT) ) { Dispose(t); SuppressScope(); t = LexGetToken(); while( is_word(type(t)) && !is_string(t, KW_DEF) && !is_string(t, KW_IMPORT) && !is_string(t, KW_MACRO) && !is_string(t, KW_EXTEND) ) { Link(export_list, t); t = LexGetToken(); } UnSuppressScope(); } if( res_type == LOCAL && !is_string(t, KW_DEF) && !is_string(t, KW_MACRO) ) { Error(5, 30, "keyword %s or %s expected here", WARN, &fpos(t), KW_DEF, KW_MACRO); break; } if( res_type == NPAR && !is_string(t, KW_NAMED) ) { Error(5, 31, "keyword %s expected here", WARN, &fpos(t), KW_NAMED); break; } if( is_string(t, KW_MACRO) ) { if( Down(export_list) != export_list ) Error(5, 32, "ignoring export list of macro", WARN, &fpos(t)); res = ReadMacro(&t, curr_encl, encl); } else { SuppressScope(); Dispose(t); t = LexGetToken(); /* check for compulsory keyword */ if( res_type == NPAR && is_string(t, KW_COMPULSORY) ) { compulsory_par = TRUE; Dispose(t); t = LexGetToken(); } else compulsory_par = FALSE; /* find name of symbol and insert it */ if( !is_word(type(t)) ) { Error(5, 33, "symbol name expected here", WARN, &fpos(t)); debug1(ANY, D, "offending type is %s", Image(type(t))); UnSuppressScope(); *token = t; return; } res = InsertSym(string(t), res_type, &fpos(t), DEFAULT_PREC, FALSE, FALSE, 0, curr_encl, nilobj); if( curr_encl != encl ) visible(res) = TRUE; if( has_import_encl ) { imports_encl(res) = TRUE; debug1(DCE, D, " setting import_encl(%s) to TRUE", SymName(res)); } if( compulsory_par ) { has_compulsory(encl)++; is_compulsory(res) = TRUE; } Dispose(t); t = LexGetToken(); /* find alternative names for this symbol */ while( is_word(type(t)) && !is_string(t, KW_NAMED) && !is_string(t, KW_IMPORT) && !is_string(t, KW_FORCE) && !is_string(t, KW_INTO) && !is_string(t, KW_HORIZ) && !is_string(t, KW_PRECEDENCE) && !is_string(t, KW_ASSOC) && !is_string(t, KW_LEFT) && !is_string(t, KW_RIGHT) && !is_string(t, KW_BODY) && !is_string(t, KW_LBR) && !is_string(t, KW_BEGIN) ) { InsertAlternativeName(string(t), res, &fpos(t)); Dispose(t); t = LexGetToken(); } /* find force, if any */ if( is_string(t, KW_FORCE) ) { force_target(res) = TRUE; Dispose(t); t = LexGetToken(); if( !is_string(t, KW_INTO) && !is_string(t, KW_HORIZ) ) Error(5, 34, "%s expected here", WARN, &fpos(t), KW_INTO); } /* find horizontally, if any */ if( is_string(t, KW_HORIZ) ) { horiz_galley(res) = COLM; Dispose(t); t = LexGetToken(); /* *** want to allow KW_HORIZ with @Target form now if( !is_string(t, KW_INTO) ) Error(5, 35, "%s expected here", WARN, &fpos(t), KW_INTO); *** */ } /* find into clause, if any */ res_target = nilobj; if( is_string(t, KW_INTO) ) { UnSuppressScope(); Dispose(t); t = LexGetToken(); if( type(t) != LBR ) { Error(5, 36, "%s expected here", WARN, &fpos(t), KW_LBR); debug1(ANY, D, "offending type is %s", Image(type(t))); UnSuppressScope(); *token = t; return; } res_target = Parse(&t, curr_encl, FALSE, FALSE); SuppressScope(); if( t == nilobj ) t = LexGetToken(); } /* find precedence clause, if any */ if( is_string(t, KW_PRECEDENCE) ) { int prec = 0; UnSuppressScope(); Dispose(t); t = LexGetToken(); while( type(t) == WORD && decimaldigit(string(t)[0]) ) { prec = prec * 10 + digitchartonum(string(t)[0]); Dispose(t); t = LexGetToken(); } SuppressScope(); if( prec < MIN_PREC ) { Error(5, 37, "precedence is too low (%d substituted)", WARN, &fpos(t), MIN_PREC); prec = MIN_PREC; } else if( prec > MAX_PREC ) { Error(5, 38, "precedence is too high (%d substituted)", WARN, &fpos(t), MAX_PREC); prec = MAX_PREC; } precedence(res) = prec; } /* find associativity clause, if any */ if( is_string(t, KW_ASSOC) ) { UnSuppressScope(); Dispose(t); t = LexGetToken(); if( is_string(t, KW_LEFT) ) right_assoc(res) = FALSE; else if( !is_string(t, KW_RIGHT) ) Error(5, 39, "associativity altered to %s", WARN, &fpos(t), KW_RIGHT); SuppressScope(); Dispose(t); t = LexGetToken(); } /* find left parameter, if any */ if( is_string(t, KW_LEFT) ) { Dispose(t); t = LexGetToken(); if( type(t) != WORD ) { Error(5, 40, "cannot find %s parameter name", WARN, &fpos(t), KW_LEFT); debug1(ANY, D, "offending type is %s", Image(type(t))); UnSuppressScope(); *token = t; return; } InsertSym(string(t), LPAR, &fpos(t), DEFAULT_PREC, FALSE, FALSE, 0, res, nilobj); Dispose(t); t = LexGetToken(); } /* find named parameters, if any */ UnSuppressScope(); ReadDefinitions(&t, res, NPAR); /* find right or body parameter, if any */ if( is_string(t, KW_RIGHT) || is_string(t, KW_BODY) ) { has_body(res) = is_string(t, KW_BODY); SuppressScope(); Dispose(t); t = LexGetToken(); if( type(t) != WORD ) { Error(5, 41, "cannot find %s parameter name", WARN,&fpos(t),KW_RIGHT); debug1(ANY, D, "offending type is %s", Image(type(t))); UnSuppressScope(); *token = t; return; } InsertSym(string(t), RPAR, &fpos(t), DEFAULT_PREC, FALSE, FALSE, 0, res, nilobj); UnSuppressScope(); Dispose(t); t = LexGetToken(); } /* read local definitions and body */ if( res_target != nilobj ) InsertSym(KW_TARGET, LOCAL, &fpos(res_target), DEFAULT_PREC, FALSE, FALSE, 0, res, res_target); if( type(t) == WORD && StringEqual(string(t), KW_LBR) ) { z = NewToken(LBR, &fpos(t), 0, 0, LBR_PREC, StartSym); Dispose(t); t = z; } else if( type(t) == WORD && StringEqual(string(t), KW_BEGIN) ) { z = NewToken(BEGIN, &fpos(t), 0, 0, BEGIN_PREC, StartSym); Dispose(t); t = z; } else if( type(t) != LBR && type(t) != BEGIN ) Error(5, 42, "opening left brace or @Begin of %s expected", FATAL, &fpos(t), SymName(res)); if( type(t) == BEGIN ) actual(t) = res; PushScope(res, FALSE, FALSE); BodyParAllowed(); sym_body(res) = Parse(&t, res, TRUE, FALSE); /* set visible flag of the exported symbols */ for( link=Down(export_list); link != export_list; link=NextDown(link) ) { Child(y, link); z = SearchSym(string(y), StringLength(string(y))); if( z == nilobj || enclosing(z) != res ) Error(5, 43, "exported symbol %s is not defined in %s", WARN, &fpos(y), string(y), SymName(res)); else if( has_body(res) && type(z) == RPAR ) Error(5, 44, "body parameter %s may not be exported", WARN, &fpos(y), string(y)); else if( visible(z) ) Error(5, 45, "symbol %s exported twice", WARN, &fpos(y), string(y)); else visible(z) = TRUE; } DisposeObject(export_list); /* pop scope of res */ PopScope(); } /* pop import scopes and store imports in sym tab */ for( link=Down(import_list); link != import_list; link=NextDown(link) ) { PopScope(); } if( Down(import_list) == import_list || curr_encl != encl ) { DisposeObject(import_list); import_list = nilobj; } else { imports(res) = import_list; } BodyParAllowed(); if( t == nilobj ) t = LexGetToken(); } /* end while */ *token = t; return; } /* end ReadDefinitions */
static void ReadTokenList(OBJECT token, OBJECT res) { OBJECT t, xsym, new_par, imps, link, y; int scope_count, i; NextToken(t, res); for(;;) switch(type(t)) { case WORD: if( string(t)[0] == CH_SYMSTART ) Error(5, 11, "symbol %s unknown or misspelt", WARN, &fpos(t), string(t)); NextToken(t, res); break; case QWORD: NextToken(t, res); break; case VCAT: case HCAT: case ACAT: case CROSS: case FORCE_CROSS: case NULL_CLOS: case PAGE_LABEL: case BEGIN_HEADER: case END_HEADER: case SET_HEADER: case CLEAR_HEADER: case ONE_COL: case ONE_ROW: case WIDE: case HIGH: case HSHIFT: case VSHIFT: case HMIRROR: case VMIRROR: case HSCALE: case VSCALE: case HCOVER: case VCOVER: case SCALE: case KERN_SHRINK: case HCONTRACT: case VCONTRACT: case HLIMITED: case VLIMITED: case HEXPAND: case VEXPAND: case START_HVSPAN: case START_HSPAN: case START_VSPAN: case HSPAN: case VSPAN: case PADJUST: case HADJUST: case VADJUST: case ROTATE: case BACKGROUND: case RAW_VERBATIM: case VERBATIM: case CASE: case YIELD: case BACKEND: case XCHAR: case FONT: case SPACE: case YUNIT: case ZUNIT: case SET_CONTEXT: case GET_CONTEXT: case BREAK: case UNDERLINE: case UNDERLINE_COLOUR: case COLOUR: case TEXTURE: case OUTLINE: case LANGUAGE: case CURR_LANG: case CURR_FAMILY: case CURR_FACE: case CURR_YUNIT: case CURR_ZUNIT: case COMMON: case RUMP: case MELD: case INSERT: case ONE_OF: case NEXT: case PLUS: case MINUS: case TAGGED: case INCGRAPHIC: case SINCGRAPHIC: case PLAIN_GRAPHIC: case GRAPHIC: case LINK_SOURCE: case LINK_DEST: case LINK_DEST_NULL: case LINK_URL: case NOT_REVEALED: NextToken(t, res); break; case LUSE: case LVIS: case ENV: case USE: case DATABASE: case SYS_DATABASE: case PREPEND: case SYS_PREPEND: case INCG_REPEATED: case SINCG_REPEATED: case OPEN: Error(5, 12, "symbol %s not allowed in macro", WARN, &fpos(t), SymName(actual(t))); NextToken(t, res); break; case LBR: ReadTokenList(t, res); NextToken(t, res); break; case UNEXPECTED_EOF: Error(5, 13, "unexpected end of input", FATAL, &fpos(t)); break; case BEGIN: Error(5, 14, "%s not expected here", WARN, &fpos(t), SymName(actual(t))); NextToken(t, res); break; case RBR: if( type(token) != LBR ) Error(5, 15, "unmatched %s in macro", WARN, &fpos(t), KW_RBR); return; case END: if( type(token) != BEGIN ) Error(5, 16, "unmatched %s in macro", WARN, &fpos(t), KW_END); else { NextToken(t, res); if( type(t) != CLOSURE ) { if( type(t) == WORD && string(t)[0] == CH_SYMSTART ) Error(5, 17, "symbol %s unknown or misspelt", WARN, &fpos(t), string(t)); else Error(5, 18, "symbol name expected after %s", WARN,&fpos(t),KW_END); } else if( actual(token) != actual(t) ) Error(5, 19, "%s %s does not match %s %s", WARN, &fpos(t), SymName(actual(token)), KW_BEGIN, SymName(actual(t)), KW_END); } return; case CLOSURE: xsym = actual(t); PushScope(xsym, TRUE, FALSE); NextToken(t, res); PopScope(); if( type(t) == CROSS || type(t) == FORCE_CROSS ) { NextToken(t, res); break; } /* read named parameters */ while( type(t) == CLOSURE && enclosing(actual(t)) == xsym && type(actual(t)) == NPAR ) { new_par = t; NextToken(t, res); if( type(t) != LBR ) { if( type(t) == RBR ) { if( type(token) != LBR ) Error(5, 20, "unmatched %s in macro", WARN, &fpos(t), KW_RBR); return; } Error(5, 21, "%s must follow named parameter %s", WARN, &fpos(new_par), KW_LBR, SymName(actual(new_par))); break; } /* add import list of the named parameter to current scope */ scope_count = 0; imps = imports(actual(new_par)); if( imps != nilobj ) { for( link = Down(imps); link != imps; link = NextDown(link) ) { Child(y, link); PushScope(actual(y), FALSE, TRUE); scope_count++; } } /* read the body of the named parameter */ PushScope(actual(new_par), FALSE, FALSE); ReadTokenList(t, res); PopScope(); /* pop the scopes pushed for the import list */ for( i = 0; i < scope_count; i++ ) PopScope(); /* get next token, possibly another named parameter */ PushScope(xsym, TRUE, FALSE); NextToken(t, res); PopScope(); } /* read body parameter, if any */ if( has_body(xsym) ) { if( type(t) == LBR || type(t) == BEGIN ) { PushScope(xsym, FALSE, TRUE); PushScope(ChildSym(xsym, RPAR), FALSE, FALSE); if( type(t) == BEGIN ) actual(t) = xsym; ReadTokenList(t, res); PopScope(); PopScope(); NextToken(t, res); } else if( type(t) != RBR && type(t) != END ) Error(5, 22, "right parameter of %s must begin with %s", WARN, &fpos(t), SymName(xsym), KW_LBR); } break; default: Error(5, 23, "ReadTokenList: %s", INTERN, &fpos(t), Image(type(t))); break; } } /* end ReadTokenList */
OBJECT ClosureExpand(OBJECT x, OBJECT env, BOOLEAN crs_wanted, OBJECT *crs, OBJECT *res_env) { OBJECT link, y, res, prnt_env, par, prnt; debug3(DCE, D, "[ ClosureExpand( %s, %s, %s, crs, res_env )", EchoObject(x), EchoObject(env), bool(crs_wanted)); assert( type(x) == CLOSURE, "ClosureExpand given non-CLOSURE!"); assert( predefined(actual(x)) == FALSE, "ClosureExpand given predefined!" ); /* add tag to x if needed but not provided; add cross-reference to crs */ if( has_tag(actual(x)) ) CrossAddTag(x); if( crs_wanted && has_tag(actual(x)) ) { OBJECT tmp = CopyObject(x, no_fpos); AttachEnv(env, tmp); y = CrossMake(actual(x), tmp, CROSS_TARG); New(tmp, CROSS_TARG); actual(tmp) = y; Link(tmp, y); if( *crs == nilobj ) New(*crs, CR_LIST); Link(*crs, tmp); } /* case x is a parameter */ res = *res_env = nilobj; if( is_par(type(actual(x))) ) { prnt = SearchEnv(env, enclosing(actual(x))); if( prnt != nilobj ) { prnt_env = GetEnv(prnt); for( link = Down(prnt); link != prnt; link = NextDown(link) ) { Child(par, link); if( type(par) == PAR && actual(par) == actual(x) ) { assert( Down(par) != par, "ExpandCLosure: Down(par)!"); Child(res, Down(par)); if( dirty(enclosing(actual(par))) || is_enclose(actual(par)) ) { debug2(DCE, DD, "copy %s %s", SymName(actual(par)), EchoObject(res)); res = CopyObject(res, no_fpos); } else { debug2(DCE, DD, "link %s %s", FullSymName(actual(par), AsciiToFull(".")), EchoObject(res)); DeleteLink(Down(par)); y = MakeWord(WORD, STR_NOCROSS, &fpos(res)); Link(par, y); } ReplaceNode(res, x); if( type(actual(x)) == RPAR && has_body(enclosing(actual(x))) ) { debug0(DCR, DDD, " calling SetEnv from ClosureExpand (a)"); *res_env = SetEnv(prnt, nilobj); DisposeObject(x); } else if( type(actual(x)) == NPAR && imports_encl(actual(x)) ) { debug0(DCR, DDD, " calling SetEnv from ClosureExpand (x)"); AttachEnv(env, x); *res_env = SetEnv(x, nilobj); } else { AttachEnv(env, x); debug0(DCR, DDD, " calling SetEnv from ClosureExpand (b)"); *res_env = SetEnv(x, prnt_env); } break; } } } else { /* fail only if there is no default value available */ if( sym_body(actual(x)) == nilobj ) { debug3(DCE, D, "failing ClosureExpand( %s, crs, %s, %s, res_env )", EchoObject(x), bool(crs_wanted), EchoObject(env)); Error(9, 2, "no value for parameter %s of symbol %s:", WARN, &fpos(x), SymName(actual(x)), SymName(enclosing(actual(x)))); Error(9, 1, "symbol with import list misused", FATAL, &fpos(x)); } } } /* case x is a user-defined symbol or default parameter */ if( res == nilobj ) { if( sym_body(actual(x)) == nilobj ) res = MakeWord(WORD, STR_NOCROSS, &fpos(x)); else res = CopyObject(sym_body(actual(x)), &fpos(x)); ReplaceNode(res, x); AttachEnv(env, x); debug0(DCR, DDD, " calling SetEnv from ClosureExpand (c)"); *res_env = SetEnv(x, nilobj); } assert( *res_env!=nilobj && type(*res_env)==ENV, "ClosureExpand: *res_env!"); debug0(DCE, D, "] ClosureExpand returning, res ="); ifdebug(DCE, D, DebugObject(res)); debug1(DCE, D, " environment = %s", EchoObject(*res_env)); return res; } /* end ClosureExpand */