# Copyright (c) 1991: 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
ilk function_like category function

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 lambda_like category lambda
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">
ilk leq_like category binop translation <"\\ro\\leq">
ilk geq_like category binop translation <"\\ro\\geq">

reserved not ilk not_like
reserved neq ilk neq_like
reserved and ilk and_like
reserved or ilk or_like
reserved leq ilk leq_like
reserved geq ilk geq_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 join 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

reserved function ilk function_like
reserved lambda ilk lambda_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

# Lambda calculus (far from complete and probably incorrect)
lambda simp --> simp
function [ open simp terminator ] --> function open 
function open simp close --> 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