summaryrefslogtreecommitdiff
path: root/web/reduce/rweb/rweave.ch
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /web/reduce/rweb/rweave.ch
Initial commit
Diffstat (limited to 'web/reduce/rweb/rweave.ch')
-rw-r--r--web/reduce/rweb/rweave.ch209
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
+
+