summaryrefslogtreecommitdiff
path: root/web/spiderweb/src/reduce
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/spiderweb/src/reduce
Initial commit
Diffstat (limited to 'web/spiderweb/src/reduce')
-rw-r--r--web/spiderweb/src/reduce/INSTALL26
-rw-r--r--web/spiderweb/src/reduce/Makefile152
-rw-r--r--web/spiderweb/src/reduce/README69
-rw-r--r--web/spiderweb/src/reduce/make3
-rw-r--r--web/spiderweb/src/reduce/reduce.spider283
-rw-r--r--web/spiderweb/src/reduce/rtangle10
-rw-r--r--web/spiderweb/src/reduce/rtangle.ch135
-rw-r--r--web/spiderweb/src/reduce/rweave.ch149
-rw-r--r--web/spiderweb/src/reduce/underscore.web32
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);
+}
+