diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /web/reduce/rweb/rweave.ch |
Initial commit
Diffstat (limited to 'web/reduce/rweb/rweave.ch')
-rw-r--r-- | web/reduce/rweb/rweave.ch | 209 |
1 files changed, 209 insertions, 0 deletions
diff --git a/web/reduce/rweb/rweave.ch b/web/reduce/rweb/rweave.ch new file mode 100644 index 0000000000..7c0c1346b1 --- /dev/null +++ b/web/reduce/rweb/rweave.ch @@ -0,0 +1,209 @@ +% Copyright (c) 1991: Marcel Roelofs and Peter Gragert +% University of Twente, Enschede, The Netherlands +% @@(#) rweave.ch (91/03/11) + +@x + if (isdigit(c)) @<Get a constant@>@; /*spider*/ + else if (isalpha(c) || c=='_') @<Get an identifier@>@;/*spider*/ + else if (c=='\'' || c=='"') @<Get a string@>@;/*spider*/ +@y + if (isdigit(c)) @<Get a constant@>@;/*spider*/ + else if (isalpha(c) || c=='_' || c=='!') @<Get an identifier@>@;/*spider*/ + else if (c=='\"') @<Get a string@>@;/*spider*/ +@z + +@x +@ @<Get an identifier@>= {/*spider*/ + id_first=--loc; + while (isalpha(*++loc) || isdigit(*loc) || *loc=='_'); + id_loc=loc; return(identifier); +} +@y +@ @<Get an identifier@>= {/*spider*/ + id_first=--loc; + if (c=='!') ++loc; + while (isalpha(*++loc) || isdigit(*loc) || *loc=='_' || *loc=='!') + if (*loc=='!') ++loc; + id_loc=loc; return(identifier); +} +@z + +@x +@ \cee\ strings and character constants, delimited by double and single +quotes, respectively, can contain newlines or instances of their own +delimiters if they are protected by a backslash. We follow this +convention, but do not allow the string to be longer than |longest_name|. + +@<Get a string@>= {/*spider*/ + ASCII delim = c; /* what started the string */ + id_first = mod_text+1; + id_loc = mod_text; + if (delim=='`' && *(loc-2)==at_sign) { + /* make string begin with |"@@`"| */ + *++id_loc=at_sign; + *++id_loc=at_sign; + } + /* this is hack for ascii constant */ +@# +/* if it's not a single-character literal, it's a tick mark or an |at_sign| */ + if ((delim=='\'' || delim == '`') && + (loc+1>=limit || + (*loc != '\\' && *loc!=at_sign && loc[1]!='\'') || + (*loc=='\\' && (loc+2>=limit||loc[2]!='\'')) || + (*loc==at_sign && + (loc+2>=limit||loc[1]!=at_sign||loc[2]!='\'')) + ) + ) goto mistake; + *++id_loc=delim; + if (delim=='`') delim='\''; /* for |ascii_constant|s */ + while (1) { + if (loc>=limit) { + if(*(limit-1)!='\\') { + err_print("! String didn't end"); loc=limit; break; +@.String didn't end@> + } + if(get_line()==0) { + err_print("! Input ended in middle of string"); loc=buffer; break; +@.Input ended in middle of string@> + } + } + if ((c=*loc++)==delim) { + if (++id_loc<=mod_text_end) *id_loc=c; + break; + } + if (c=='\\') if (loc>=limit) continue; + else if (++id_loc<=mod_text_end) { + *id_loc = '\\'; c=*loc++; + } + if (++id_loc<=mod_text_end) *id_loc=c; + } + if (id_loc>=mod_text_end) { + printf("\n! String too long: "); +@.String too long@> + ASCII_write(mod_text+1,25); + printf("..."); mark_error; + } + id_loc++; + return(string); +} +@y +@ \cee\ strings are delimited by double quotes and must be restricted +to one line. Double quotes in strings must be doubled and we allow no +string to be longer than |longest_name|. + +@<Get a string@>= {/*spider*/ + ASCII delim = c; /* what started the string */ +@# + id_first = mod_text+1; + id_loc = mod_text; *++id_loc=delim; + while (1) { + if (loc>=limit) { + err_print("! String didn't end"); loc=limit; +@.String didn't end@> + if (get_line()==0) { + err_print("! Input ended in middle of string"); loc=buffer; +@.Input ended in middle of string@> + } + break; + } + if ((c=*loc++)==delim) { + if (++id_loc<=mod_text_end) *id_loc=c; + if (*loc==delim) loc++; + else break; + } + if (++id_loc<=mod_text_end) *id_loc=c; + } + if (id_loc>=mod_text_end) { + printf("\n! String too long: "); +@.String too long@> + ASCII_write(mod_text+1,25); + printf("..."); mark_error; + } + id_loc++; + return(string); +} +@z + +@x + case 1: printf("\\{"); print_id((name_dir+r)); printf("}"); break; + /* |id_flag| */ + case 2: printf("\&{"); print_id((name_dir+r)); printf("}"); break; +@y + case 1: printf("\\\\{"); print_id((name_dir+r)); printf("}"); break; + /* |id_flag| */ + case 2: printf("\\&{"); print_id((name_dir+r)); printf("}"); break; +@z + +@x +@ @<Start a format...@>= { + app_str("\\F"); app_scrap(SP_ignore_scrap,no_math); + /* this will produce `\&{format}' */ +@.\\F@> +@<Set |next_control| to the first non-newline token@>@; +/* claim at this point |scrap_ptr==scrap_info+1| */ + if (scrap_ptr!=scrap_info+1) { + err_print("! This can't happen -- bad scrap_ptr in format definition"); + printf("\n\tscrap_ptr-scrap_info==%d\n",scrap_ptr-scrap_info); + } + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + app_str(" "); + app_scrap(SP_ignore_scrap,no_math); /*spider*/ + /* this is syntactically separate from what follows */ + @<Set |next_control| to the first non-newline token@>@; + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + small_app(@`\n'); + app_scrap(SP_ignore_scrap,no_math); + @<Set |next_control| to the first non-newline token@>@; + } + } + /* if everything went well, we appended two scraps */ + if (scrap_ptr!=scrap_info+3) err_print("! Improper format definition"); +@.Improper format definition@> +} +@y +@ @<Start a format...@>= { + small_app(backup); app_str("\\F"); app_scrap(SP_ignore_scrap,no_math); + /* this will produce `\&{format}' */ +@.\\F@> +@<Set |next_control| to the first non-newline token@>@; +/* claim at this point |scrap_ptr==scrap_info+1| */ + if (scrap_ptr!=scrap_info+1) { + err_print("! This can't happen -- bad scrap_ptr in format definition"); + printf("\n\tscrap_ptr-scrap_info==%d\n",scrap_ptr-scrap_info); + } + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + app_str(" "); + app_scrap(SP_ignore_scrap,no_math); /*spider*/ + /* this is syntactically separate from what follows */ + @<Set |next_control| to the first non-newline token@>@; + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + small_app(@`\n'); + app_scrap(SP_ignore_scrap,no_math); + @<Set |next_control| to the first non-newline token@>@; + } + } + /* if everything went well, we appended two scraps */ + if (scrap_ptr!=scrap_info+2) err_print("! Improper format definition"); +@.Improper format definition@> +} +@z + +@x +if (cur_xref->num%def_flag!=module_count) { + app_str("+"); /*module name is multiply defined*/ + this_module=name_dir; /*so we won't give cross-reference info here*/ +} +app_str("\\S"); /* output an equivalence sign */ +@y +if (cur_xref->num%def_flag!=module_count) { + app_str("\\PS"); /*module name is multiply defined*/ + this_module=name_dir; /*so we won't give cross-reference info here*/ +} +else app_str("\\S"); /* output an equivalence sign */ +@z + + |