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/spiderweb/src/reduce |
Initial commit
Diffstat (limited to 'web/spiderweb/src/reduce')
-rw-r--r-- | web/spiderweb/src/reduce/INSTALL | 26 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/Makefile | 152 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/README | 69 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/make | 3 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/reduce.spider | 283 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/rtangle | 10 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/rtangle.ch | 135 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/rweave.ch | 149 | ||||
-rw-r--r-- | web/spiderweb/src/reduce/underscore.web | 32 |
9 files changed, 859 insertions, 0 deletions
diff --git a/web/spiderweb/src/reduce/INSTALL b/web/spiderweb/src/reduce/INSTALL new file mode 100644 index 0000000000..52aa82a432 --- /dev/null +++ b/web/spiderweb/src/reduce/INSTALL @@ -0,0 +1,26 @@ +In this directory you can find the stuff necessary for building RWEB, +the REDUCE version of SPIDERY WEB. + +Along with these files you need a version of SPIDERY WEB, which can be +obtained by anonymous ftp from princeton.edu (128.112.128.1). + +After you have installed SPIDERY WEB you know what it means to put the +files contained in this directory into a new directory $(WEBROOT)/reduce. +Do it. You might as well want to change the variable HOME in +$(WEBROOT)/reduce/Makefile (which is in fact an adapted version of +$(MASTER)/WebMakefile). + +In order to make RWEB, go to $(WEBROOT)/reduce and type 'make weave', +'make tangle' or 'make web', if you want to make rweave, rtangle or +both. The documentation needed for using RWEB is +$(WEBROOT)/doc/spiderwebman.tex. + +Have fun, + +Marcel Roelofs, +University of Twente, +Department of applied mathematics, +P.O. Box 217, +7500 AE Enschede, +The Netherlands. +E-mail: roelofs@math.utwente.nl diff --git a/web/spiderweb/src/reduce/Makefile b/web/spiderweb/src/reduce/Makefile new file mode 100644 index 0000000000..ec100b3bcb --- /dev/null +++ b/web/spiderweb/src/reduce/Makefile @@ -0,0 +1,152 @@ +# Copyright 1989 by Norman Ramsey, Odyssey Research Associates. +# Not to be sold, but may be used freely for any purpose. +# For more information, see file COPYRIGHT in the parent directory. + +HOME=/users/redusers# # Make no longer inherits environment vars + +THETANGLE=tangle +THEWEAVE=weave +SPIDER=any.spider +# +DVI=dvi +CFLAGS=-DDEBUG -g -DSTAT + +# CPUTYPE is a grim hack that attempts to solve the problem of multiple +# cpus sharing a file system. In my environment I have to have different +# copies of object and executable for vax, sun3, next, iris, and other +# cpu types. If you will be using Spidery WEB in a homogenous processor +# environment, you can just set CPUTYPE to a constant, or eliminate it +# entirely. +# +# In my environment, the 'cputype' program returns a string that +# describes the current processor. That means that the easiest thing +# for you to do is to define a 'cputype' program that does something +# sensible. A shell script that says 'echo "vax"' is fine. + +CPUTYPE=`cputype` + +# Change the following three directories to match your installation +# +# the odd placement of # is to prevent any trailing spaces from slipping in + +WEBROOT=$(HOME)/spider# # root of the WEB source distribution +DEST=$(HOME)/bin# # place where the executables go +MACROS=$(HOME)/tex/inputs# # place where the macros go + +MASTER=$(WEBROOT)/master# # master source directory +OBDIR=$(MASTER)/$(CPUTYPE)# #common object files + +TANGLESRC=tangle +CTANGLE=ceetangle -I$(MASTER) +CWEAVE=ceeweave -I$(MASTER) +AWKTANGLE=awktangle -I$(MASTER) +COMMONOBJS=$(OBDIR)/common.o $(OBDIR)/pathopen.o +COMMONC=$(MASTER)/common.c $(MASTER)/pathopen.c +COMMONSRC=$(COMMONC) $(MASTER)/spider.awk + + +# Our purpose is to make tangle and weave + +web: tangle weave + +tangle: mktangle underscore + +mktangle: $(COMMONOBJS) $(TANGLESRC).o + $(CC) $(CFLAGS) -o $(DEST)/$(THETANGLE) $(COMMONOBJS) $(TANGLESRC).o + +weave: $(COMMONOBJS) weave.o + $(CC) $(CFLAGS) -o $(DEST)/$(THEWEAVE) $(COMMONOBJS) weave.o + +underscore: $(DEST)/underscore underscore.web + +$(DEST)/underscore: + $(CTANGLE) underscore.web + $(CC) $(CFLAGS) -o $(DEST)/underscore underscore.c + cp rtangle $(DEST)/rtangle + +source: $(TANGLESRC).c $(COMMONSRC) # make tangle.c and common src, then clean + if [ -f WebMakefile ]; then exit 1; fi # don't clean the master! + if [ -f spiderman.tex ]; then exit 1; fi # don't clean the manual + -rm -f tangle.web weave.* common.* # remove links that may be obsolete + -rm -f *.unsorted *.list grammar.web outtoks.web scraps.web + -rm -f cycle.test spider.slog + -rm -f *.o *.tex *.toc *.dvi *.log *.makelog *~ *.wlog *.printlog + +# Here is how we make the common stuff + +$(MASTER)/common.c: $(MASTER)/common.web # no change file + $(CTANGLE) $(MASTER)/common + +$(OBDIR)/common.o: $(MASTER)/common.c + $(CC) $(CFLAGS) -c $(MASTER)/common.c + mv common.o $(OBDIR) + + +$(MASTER)/pathopen.c: $(MASTER)/pathopen.web # no change file + $(CTANGLE) $(MASTER)/pathopen + mv pathopen.h $(MASTER) + +$(OBDIR)/pathopen.o: $(MASTER)/pathopen.c + $(CC) $(CFLAGS) -c $(MASTER)/pathopen.c + mv pathopen.o $(OBDIR) + +$(OBDIR): + if /bin/test ! -d $(OBDIR) ; then mkdir $(OBDIR) ; fi + +## Now we make the tangle and weave source locally + +$(TANGLESRC).c: $(MASTER)/$(TANGLESRC).web $(MASTER)/common.h grammar.web rtangle.ch + -/bin/rm -f $(TANGLESRC).web + ln $(MASTER)/$(TANGLESRC).web $(TANGLESRC).web +# chmod -w $(TANGLESRC).web + $(CTANGLE) $(TANGLESRC) rtangle.ch + +weave.c: $(MASTER)/weave.web $(MASTER)/common.h grammar.web rweave.ch + -/bin/rm -f weave.web + ln $(MASTER)/weave.web weave.web +# chmod -w weave.web + $(CTANGLE) weave rweave.ch + +## Here's where we run SPIDER to create the source + +grammar.web: $(MASTER)/cycle.awk $(MASTER)/spider.awk $(SPIDER) + echo "date" `date` | cat - $(SPIDER) | awk -f $(MASTER)/spider.awk + cat $(MASTER)/transcheck.list trans_keys.unsorted | awk -f $(MASTER)/transcheck.awk + awk -f $(MASTER)/cycle.awk < cycle.test + sort *.unsorted | awk -f $(MASTER)/nodups.awk + mv *web.tex $(MACROS) + +## We might have to make spider first. + +$(MASTER)/spider.awk: $(MASTER)/spider.web + $(AWKTANGLE) $(MASTER)/spider + mv cycle.awk nodups.awk transcheck.awk $(MASTER) + rm junk.list + + +# $(MASTER)/cycle.awk: $(MASTER)/cycle.web # making spider also makes cycle +# $(AWKTANGLE) $(MASTER)/cycle + + +# This cleanup applies to every language + +clean: + if [ -f WebMakefile ]; then exit 1; fi # don't clean the master! + if [ -f spiderman.tex ]; then exit 1; fi # don't clean the manual + -rm -f tangle.* weave.* common.* # remove links that may be obsolete + -rm -f *.unsorted *.list grammar.web outtoks.web scraps.web + -rm -f cycle.test spider.slog + -rm -f *.c *.o *.tex *.toc *.dvi *.log *.makelog *~ *.wlog *.printlog + + + +# booting the new distribution +boot: + cd ../master; rm -f *.o; for i in $(COMMONC); do \ + $(CC) $(CFLAGS) -c $$i; \ + mv *.o $(OBDIR) ; \ + done; cd ../c + $(CC) $(CFLAGS) -c $(TANGLESRC).c; \ + $(CC) $(CFLAGS) -o $(DEST)/$(THETANGLE) $(COMMONOBJS) $(TANGLESRC).o + + diff --git a/web/spiderweb/src/reduce/README b/web/spiderweb/src/reduce/README new file mode 100644 index 0000000000..0545d0e17d --- /dev/null +++ b/web/spiderweb/src/reduce/README @@ -0,0 +1,69 @@ +REDUCE is a lisp based system for symbolic computation by A. Hearn. +The real lisp is hidden for the user by a pascal like language, called +rlisp, which is parsed and converted to ordinary lisp, when read. +Due to the nature of lisp any expression that returns a value may +appear at almost any place, for instance + +b:=for i:=1:if x then y else z sum a(i)+if c then d else e+ + while x do begin ...; return ...; ... end; + +is a perfectly correct rlisp expression. REDUCE itself and all +available libraries are written in rlisp. Users can also write their +own packages in rlisp, containing both low and high level REDUCE +procedures. + +Besides the ordinary stuff available in almost any computer algebra +program, there are user written packages available for differential +geometry, determining symmetries of differential equations, lie +algebras etc., possibly using non standard data structures based on +lisp objects. + +It will be clear from the rlisp expression given above that one has to +be very careful about what has to appear in math mode and what in text +mode. Moreover some additional indentation for complicated expressions +may be desirable. +The second problem can be solved by carefully implementing the +production rules, the first one we solved by putting everything in +text mode except for the unary and binary operators like +, -, :=, +etc., and applying some tricks to get spaces that cannot be removed by +a cancel. + +Changes necessary to weave and tangle in order to parse rlisp source +code correctly are the following: +- rlisp only knows one kind of string, namely the one surrounded by double + quotes ", whereas a single quote ' is explicitly used as a 'quote'. + This means that the parsing of strings had to be adapted. +- rlisp has an escape character '!', which means that an identifier + may contain any character if it is preceded by an exclamation mark + (in this way identifiers may even contain spaces), hence the parsing + of identifiers had to be altered. +- we changed some things which seemed to be bugs: a) in the debug part of + the weave code we replaced "\\{" by "\\\\{" since our compiler + complained about it, b) "+\equiv" isn't TeX'ed in a very nice way so + we replaced it by a new TeX macro "\PS" to be used for multiply + defined modules. +- a minor change: we like tangle also to print the newlines in macros, so + we #define'd NEWLINES_IN_MACROS. +- rlisp doesn't allow underscores to occur in identifiers, unless + preceded by '!'. Therefore, we postprocess the tangled file in order + to remove the underscores. Indeed this can also be done by changing + tangle.web in the appropriate place, but I think it is more work to + find the exact place where the change has to be made, than writing a + C program that does a similar job. However, if you are more familiar + with tangle than we are and know exactly where to make the change, + feel free to do so (underscores preceded by '!' and in strings + should stay). + +Moreover, previewing the weaved & TeX'ed tangle I discovered what +seems to be a bug in your set of production rules of ceeweave, namely +'extern' followed by two simps seems to be missing a space, whereas +'extern' followed by one simp gives no problem. + +I hope this 'blurb' about REDUCE and the necessary changes is +satisfactory. I have put all necessary files tarred, compressed and +uuencoded at the end of this mail. It is also available by anonymous +ftp from utmfu0.math.utwente.nl (130.89.60.149). + +If you have comments or suggestions on our work, feel free to react. + +Marcel Roelofs. diff --git a/web/spiderweb/src/reduce/make b/web/spiderweb/src/reduce/make new file mode 100644 index 0000000000..73a59fa56a --- /dev/null +++ b/web/spiderweb/src/reduce/make @@ -0,0 +1,3 @@ +#!/bin/csh -f +/bin/make -f ../reduce/Makefile CPUTYPE=`cputype`\ + THETANGLE=rtangle.exe THEWEAVE=rweave SPIDER=reduce.spider $* diff --git a/web/spiderweb/src/reduce/reduce.spider b/web/spiderweb/src/reduce/reduce.spider new file mode 100644 index 0000000000..3a6f407cf4 --- /dev/null +++ b/web/spiderweb/src/reduce/reduce.spider @@ -0,0 +1,283 @@ +# Copyright (c): Marcel Roelofs and Peter Gragert +# University of Twente, Enschede, The Netherlands +# +# @(#) reduce.spider (91/03/11) + +language REDUCE extension r + +at_sign @ + +comment begin <"%"> end <"%"> + +default translation <*> mathness no + +line begin <"%line"> end <> + +token identifier category simp +token number category simp +token newline category newline translation <> +token pseudo_semi category terminator translation <"\\rx"> + +module definition stmt use module_scrap + +default translation <"\\ro"-*> mathness no + +token * category binop translation <"\\eo*"> +token / category binop translation <"\\eo/"> +token < category binop +token > category binop +token = category binop +token . category binop tangleto <space-"."-space> + +token .^ category binop translation <"\\ro{.\\^}"> tangleto <space-".^"-space> +token .* category binop translation <"\\ro{.*}"> tangleto <space-".*"-space> +token .+ category binop translation <"\\ro{.+}"> tangleto <space-".+"-space> +token ./ category binop translation <"\\ro{./}"> tangleto <space-"./"-space> +token ^ category binop translation <"\\eo\\^"> +token ** category binop translation <"\\eo\\^"> +token := category binop translation <"\\ro\\leftarrow"> +token != category binop translation <"\\ro\\NEQ"> tangleto <space-"neq"-space> +token <> category binop translation <"\\ro\\NEQ"> tangleto <space-"neq"-space> +token <= category binop translation <"\\ro\\leq"> +token >= category binop translation <"\\ro\\geq"> + +default translation <*> mathness no + +token + category unorbinop +token - category unorbinop +token ' category quote tangleto <space-"'"> +token '( category listopen translation <"'("> tangleto <space-"'("> +token '[ category listopen translation <"'["> tangleto <space-"'["> +token ( category open +token ) category close +token [ category simpopen +token ] category close +token { category simpopen translation <"$\\{$"> +token } category close translation <"$\\}$"> +token , category comma translation <"\\comma"-opt-1> +token ; category terminator translation <";"-break_space> +token $ category terminator translation <"\\$"-break_space> +token : category colon +token << category progn_begin translation <"\\LL"> tangleto <space-"<<"> +token >> category end translation <"\\RR"> tangleto <">>"-space> + +ilk bool_like category simp +ilk goto_like category simp + +default translation <*-space> + +ilk begin_like category begin +ilk if_like category if +ilk then_like category then +ilk else_like category else +ilk for_like category for +ilk do_like category do +ilk step_like category step +ilk repeat_like category repeat +ilk until_like category until +ilk on_like category switch +ilk return_like category return +ilk modedef_like category mode +ilk procmode_like category procmode +ilk proc_like category proc +ilk where_like category where +ilk decl_like category decl +ilk clear_like category clear +ilk end_like category end translation <*> + +ilk not_like category unop translation <"\\R"> +ilk neq_like category binop translation <"\\ro\\NEQ"> +ilk and_like category binop translation <"\\ro\\W"> +ilk or_like category binop translation <"\\ro\\V"> + +reserved not ilk not_like +reserved neq ilk neq_like +reserved and ilk and_like +reserved or ilk or_like + +reserved begin ilk begin_like +reserved end ilk end_like + +reserved if ilk if_like +reserved then ilk then_like +reserved else ilk else_like + +reserved for ilk for_like +reserved each ilk for_like +reserved foreach ilk for_like +reserved all ilk for_like +reserved forall ilk for_like + +reserved do ilk do_like +reserved sum ilk do_like +reserved product ilk do_like +reserved collect ilk do_like +reserved conc ilk do_like +reserved let ilk do_like + +reserved in ilk step_like +reserved step ilk step_like +reserved such ilk step_like +reserved that ilk step_like + +reserved repeat ilk repeat_like +reserved until ilk until_like + +reserved on ilk on_like +reserved off ilk on_like + +reserved go ilk goto_like +reserved to ilk goto_like +reserved goto ilk goto_like + +reserved return ilk return_like +reserved while ilk for_like + +reserved algebraic ilk modedef_like +reserved symbolic ilk modedef_like +reserved lisp ilk modedef_like + +reserved expr ilk procmode_like +reserved fexpr ilk procmode_like +reserved macro ilk procmode_like +reserved smacro ilk procmode_like + +reserved procedure ilk proc_like + +reserved where ilk where_like + +reserved scalar ilk decl_like +reserved integer ilk decl_like +reserved real ilk decl_like +reserved operator ilk decl_like +reserved array ilk decl_like +reserved matrix ilk decl_like +reserved linear ilk decl_like +reserved symmetric ilk decl_like +reserved antisymmetric ilk decl_like +reserved clear ilk clear_like + +reserved nil ilk bool_like +reserved t ilk bool_like + +################################## +# The production rules +################################## + +# Emergency rules, WEAVE commands & comments +newline ? --> #2 +<cancel-"\\rx"> ignore_scrap ? --> #2 +<cancel> ignore_scrap --> terminator +terminator --> stmt +end --> simp + +# Simple expressions +simp <"\\Rs"-opt-3> simp --> simp +simp binop simp --> simp +simp <"\\bo"> unorbinop simp --> simp +<"\\uo"> (unop|unorbinop) simp --> simp + +simp <"\\Rs"-indent-cancel> stmt <outdent> --> stmt +simp binop <indent-cancel> stmt <outdent> --> stmt +simp <"\\bo"> unorbinop <indent-cancel> stmt <outdent> --> stmt +<"\\uo"> (unop|unorbinop) <indent-cancel> stmt <outdent> --> stmt + +quote <cancel> ? <cancel> --> simp +simp comma simp --> simp +simp terminator --> stmt +stmt stmt --> stmt + +# Lists and vectors +open <cancel> simp <cancel> close --> simp + +listopen simp [ open ] --> listopen simp simpopen +listopen [ open ] --> listopen simpopen +listopen <"$\\,$"> close --> simp +listopen simp close --> simp + +simpopen <"$\\,$"> close --> simp +simpopen <"\\Ri"-cancel> simp <cancel-"\\Ro"> close --> simp + +# Function calls +simp open <"$\\,$"> close --> simp +simp open <"\\Ri"-cancel> simp <cancel-"\\Ro"> close --> simp + +# Procedure definitions +(mode|procmode) proc --> proc +proc stmt* <force-indent> stmt <outdent-force> --> stmt +(simp|stmt) <force> proc --> proc + +# Declarations +mode <cancel> (terminator|open) --> #2 +mode stmt --> stmt +proc stmt begin [ decl stmt* <force> ] --> proc stmt begin stmt +(decl|clear|switch|do) stmt* <force> --> stmt + +# Blocks +[ simp <break_space> ] end --> stmt end +<force> begin <force> end --> simp +<force> begin <opt-7> stmt <force> end terminator <force> --> stmt +[ <force> begin <opt-7> stmt <force> end ] !terminator --> simp !terminator +progn_begin end --> simp +<force> progn_begin <indent-cancel> stmt <cancel-outdent> end terminator <force> --> stmt +[ <force> progn_begin <indent-cancel> stmt <cancel-outdent> end ] !terminator --> simp !terminator + +# For statements in all flavours +for for --> for +for [ simp colon <opt-3> simp ] --> for simp +for [ simp <"\\Rs"> (step|until|switch) <opt-3> simp ] --> for simp +[ <force> for simp <"\\Rs"> do <opt-1-indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +<force> for simp <"\\Rs"> do <opt-1-indent> simp terminator <outdent-force> --> stmt +<force> for simp <"\\Rs"> do <opt-1-indent> stmt <outdent> --> stmt + +# If statements +if simp <"\\Rs"> then <opt-1> --> ifthen +ifthen <indent> simp <"\\Rs"-outdent-force> else <opt-1> --> ifelse +[ <force> ifelse <indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +[ <force> (if|ifthen) <indent> simp <outdent> ] (comma|close|end) --> simp (comma|close|end) +<force> (ifthen|ifelse) <indent> simp terminator <outdent-force> --> stmt +<force> (ifthen|ifelse) <indent> stmt <outdent> --> stmt + +# Where +[ simp <"\\Rs"-opt-1> where simp ] (close|else|end) --> simp (close|else|end) +simp <"\\Rs"-opt-1> where simp terminator <force> --> stmt + +# Return statement +[ <force> return <indent> simp <outdent> ] (close|else|end) --> simp (close|else|end) +<force> return <indent> simp terminator <outdent-force> --> stmt +<force> return <indent> stmt <outdent> --> stmt + +# Repeat statements +[ <force> repeat <"\\Rs"-opt-7-indent> simp <outdent-force> until <indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +<force> repeat <"\\Rs"-opt-7-indent> simp <outdent-force> until <indent> simp terminator <outdent-force> --> stmt + +# Labels +!for [ <force-backup> simp colon <"\\Rs"-cancel> (simp|end) ] --> !for #4 + +# Module use +stmt <force> module_scrap terminator <force> --> stmt +module_scrap --> simp + +macros begin +\def\commentbegin{\{} +\def\commentend{\}} +\def\comma{$,{}$} +\def\uo#1{$#1$} +\def\ro#1{${}\mathrel{#1}{}$} +\def\bo#1{${}\mathbin{#1}{}$} +\def\eo#1{$#1$} +\def\NEQ{\hbox{$\ne$}} +\def\LL{$\ll\,$} +\def\RR{$\,\gg$} +\def\PS{\joinrel{+\equiv}} +\let\rx\relax +\newcount\extraindent +\def\Ri{\global\advance\extraindent by1} +\def\Ro{\global\advance\extraindent by-1} +\def\Rs{{ }} +\def\startline{\noindent\count255=\ind + \ifnum\extraindent=0\advance\count255by-2\fi + \hskip\count255 em} +\def\3#1{\hfil\ifnum#1=0\penalty-100\else\penalty#10\fi\hfilneg} +macros end + diff --git a/web/spiderweb/src/reduce/rtangle b/web/spiderweb/src/reduce/rtangle new file mode 100644 index 0000000000..6c32919c89 --- /dev/null +++ b/web/spiderweb/src/reduce/rtangle @@ -0,0 +1,10 @@ +#!/bin/ksh +# Copyright (c): Marcel Roelofs and Peter Gragert +# University of Twente, Enschede, The Netherlands +# +# @(#) rtangle (91/03/11) + +webfile=$1 +shift +rtangle.exe ${webfile} $* +underscore <${webfile}.r > ${webfile}.red diff --git a/web/spiderweb/src/reduce/rtangle.ch b/web/spiderweb/src/reduce/rtangle.ch new file mode 100644 index 0000000000..b6edbe8e19 --- /dev/null +++ b/web/spiderweb/src/reduce/rtangle.ch @@ -0,0 +1,135 @@ +% Copyright (c): Marcel Roelofs and Peter Gragert +% University of Twente, Enschede, The Netherlands +% @@(#) rtangle.ch (91/03/11) + +@x +@u +@<Include files@>@; +@<Common code for \.{WEAVE} and \.{TANGLE}@>@; +@<Typedef declarations@>@; +@<Global variables@>@; +@y +@u +#define NEWLINES_IN_MACROS +@<Include files@>@; +@<Common code for \.{WEAVE} and \.{TANGLE}@>@; +@<Typedef declarations@>@; +@<Global variables@>@; +@z + +@x + if (isdigit(c) || c=='\\' || c=='.') @<Get a constant@>@;/*spider*/ + else if (isalpha(c) || 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=='_'); + if (*loc=='$') while (isdigit(*++loc)||*loc=='$'); + /* make room for \$\$ and \$nnn suffixes */ + 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 */ +@# +/* if it's not a single-character literal, it's a tick mark or an |at_sign| */ + if (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_first = mod_text+1; + id_loc = mod_text; *++id_loc=delim; + 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@> + } + else if (++id_loc<=mod_text_end) *id_loc=@`\n'; /* will print as + \.{"\\\\\\n"} */ + } + if ((c=*loc++)==delim) { + if (++id_loc<=mod_text_end) *id_loc=c; + break; + } + if (c=='\\') { + if (loc>=limit) continue; + 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 diff --git a/web/spiderweb/src/reduce/rweave.ch b/web/spiderweb/src/reduce/rweave.ch new file mode 100644 index 0000000000..857cfe2d41 --- /dev/null +++ b/web/spiderweb/src/reduce/rweave.ch @@ -0,0 +1,149 @@ +% Copyright (c): 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 +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 diff --git a/web/spiderweb/src/reduce/underscore.web b/web/spiderweb/src/reduce/underscore.web new file mode 100644 index 0000000000..310de4fdac --- /dev/null +++ b/web/spiderweb/src/reduce/underscore.web @@ -0,0 +1,32 @@ +% Copyright (c): Marcel Roelofs and Peter Gragert +% University of Twente, Enschede, The Netherlands +% @@(#) underscore.web (91/03/11) + +@* Filter to remove underscores from REDUCE source. REDUCE does not +allow sole underscores in identifiers. However, underscores preceded +by an exclamation mark are allowed. Also REDUCE strings may contain +underscores. The following C program is a filter that removes the +forbidden underscores. + +@u +#include <stdio.h> + +main (ac, av) +char **av; +{ +char c; +while ((c=getc(stdin)) != EOF) + if (c=='!') { + putc(c,stdout); + c=getc(stdin); + putc(c,stdout); + } + else + if (c=='\"') { + while (putc(c,stdout), (c=getc(stdin)) != '\"') ; + putc(c,stdout); + } + else + if (c != '_') putc(c,stdout); +} + |