infix: new operators, revise precedence.

* autoload.c (infix_set_entries): Intern new symbols
||, &&, !, !=, &=, |=, &&=, ||=, >>=, <<=, ~=, %=,
*=, %=, <<, >>, &, |, ~, % and //.

* stdlib/infix.tl: revise precedence of calculating
assignment operators. Add shifts, bitwise operators,
modulo, C-like synonyms for some operators,
numerous new calculating assignments.
(sys:mod-set, sys:and-set, sys:or-set, sys:logand-set,
sys:logxor-set, sys:logior-set, sys:ash-set,
sys:asr-set, sys:asr): New macros to provide
the implementation of operation combinations that
will only be available via infix.

3 files changed, 148 insertions, 29 deletions

diff --git a/autoload.c b/autoload.c
index 377a54dd..20ef016f 100644
--- a/autoload.c
+++ b/autoload.c
@@ -1022,7 +1022,13 @@ static val infix_set_entries(val fun)
     nil
   };
   val name_noload[] = {
-    lit("+="), lit("-="), lit("**"), lit("++"), lit("--"),
+    lit("||"), lit("&&"), lit("!"),
+    lit("!="), lit("&="), lit("|="), lit("&&="), lit("||="),
+    lit(">>="), lit("<<="), lit("~="), lit("%="),
+    lit("+="), lit("-="), lit("*="),
+    lit("**"), lit("++"), lit("--"),
+    lit("<<"), lit(">>"),
+    lit("&"), lit("|"), lit("~"), lit("%"), lit("//"),
     nil
   };
   autoload_set(al_fun, name, fun);
diff --git a/stdlib/infix.tl b/stdlib/infix.tl
index 5127f60e..f783bf9d 100644
--- a/stdlib/infix.tl
+++ b/stdlib/infix.tl
@@ -51,15 +51,28 @@
 (new (ifx-oper 0 '=) arity :prefix assoc :right lispsym 'identity)
 
 (new (ifx-oper 10 ':=) assoc :right lispsym 'set)
+(new (ifx-oper 10 '+=) lispsym 'inc)
+(new (ifx-oper 10 '-=) lispsym 'dec)
+(new (ifx-oper 10 '*=) lispsym 'mul)
+(new (ifx-oper 10 '/=) lispsym 'div)
+(new (ifx-oper 10 '%=) lispsym 'sys:mod-set)
+(new (ifx-oper 10 '&&=) lispsym 'sys:and-set)
+(new (ifx-oper 10 '||=) lispsym 'sys:or-set)
+(new (ifx-oper 10 '|=) lispsym 'sys:logior-set)
+(new (ifx-oper 10 '~=) lispsym 'sys:logxor-set)
+(new (ifx-oper 10 '&=) lispsym 'sys:logand-set)
+(new (ifx-oper 10 '>>=) lispsym 'sys:asr-set)
+(new (ifx-oper 10 '<<=) lispsym 'sys:ash-set)
+
 (new (ifx-oper 11 'or))
+(new (ifx-oper 11 '||) lispsym 'or)
 (new (ifx-oper 12 'and))
+(new (ifx-oper 12 '&&) lispsym 'and)
 (new (ifx-oper 13 'not) arity :prefix assoc :right)
+(new (ifx-oper 13 '!) arity :prefix assoc :right lispsym 'not)
 
-(new (ifx-oper 20 '<))
-(new (ifx-oper 20 '>))
-(new (ifx-oper 20 '<=))
-(new (ifx-oper 20 '>=))
 (new (ifx-oper 20 '=))
+(new (ifx-oper 20 '!=) lispsym '/=)
 (new (ifx-oper 20 'eq))
 (new (ifx-oper 20 'eql))
 (new (ifx-oper 20 'equal))
@@ -67,8 +80,21 @@
 (new (ifx-oper 20 'neql))
 (new (ifx-oper 20 'nequal))
 
-(new (ifx-oper 25 '+=) lispsym 'inc)
-(new (ifx-oper 25 '-=) lispsym 'dec)
+(new (ifx-oper 25 '<))
+(new (ifx-oper 25 '>))
+(new (ifx-oper 25 '<=))
+(new (ifx-oper 25 '>=))
+(new (ifx-oper 25 'less))
+(new (ifx-oper 25 'greater))
+(new (ifx-oper 25 'lequal))
+(new (ifx-oper 25 'gequal))
+
+(new (ifx-oper 26 '|) lispsym 'logior)
+(new (ifx-oper 26 '~) lispsym 'logxor)
+(new (ifx-oper 28 '&) lispsym 'logand)
+
+(new (ifx-oper 29 '<<) lispsym 'ash)
+(new (ifx-oper 29 '>>) lispsym 'sys:asr)
 
 (new (ifx-oper 30 '-))
 (new (ifx-oper 30 '+))
@@ -78,6 +104,8 @@
 
 (new (ifx-oper 40 '*))
 (new (ifx-oper 40 '/))
+(new (ifx-oper 40 '//) lispsym 'floor)
+(new (ifx-oper 40 '%) lispsym 'mod)
 
 (new (ifx-oper 50 '**) assoc :right lispsym 'expt)
 
@@ -87,6 +115,41 @@
 (new (ifx-oper 60 '++) arity :postfix assoc :left lispsym 'pinc)
 (new (ifx-oper 60 '--) arity :postfix assoc :left lispsym 'pdec)
 
+(defmacro sys:mod-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (mod (,getter) ,value))))
+
+(defmacro sys:and-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (and (,getter) ,value))))
+
+(defmacro sys:or-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (or (,getter) ,value))))
+
+(defmacro sys:logand-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (logand (,getter) ,value))))
+
+(defmacro sys:logxor-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (logxor (,getter) ,value))))
+
+(defmacro sys:logior-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (logior (,getter) ,value))))
+
+(defmacro sys:ash-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (ash (,getter) ,value))))
+
+(defmacro sys:asr-set (place value :env env)
+  (with-update-expander (getter setter) place env
+    ^(,setter (ash (,getter) (- ,value)))))
+
+(defmacro sys:asr (num bits)
+  ^(ash ,num (- ,bits)))
+
 (defun infix-error (exp fmt . args)
   (let ((loc (source-loc-str exp)))
     (let ((msg (fmt `@loc: infix: @fmt` . args)))
diff --git a/txr.1 b/txr.1
index 508682b5..388616fd 100644
--- a/txr.1
+++ b/txr.1
@@ -54171,26 +54171,33 @@ Lisp syntax, exemplified by:
 .NP* Operator Table
 
 .TS
-tab(!);
+tab(,);
 l l l l.
-Operators!Class!Precedence!Associativity
-mathfn \f[4]=\f[]!prefix!0!right
-\f[4]:=\f[]!infix!1!right
-\f[4]or\f[]!infix!2!left
-\f[4]and\f[]!infix!3!left
-\f[4]not\f[]!prefix!3!right
-\f[4]< > <= >= =\f[]!infix!4!left
-\f[4]eq eql equal\f[]!!!
-\f[4]neq neql nequal\f[]!!!
-\f[4]+= -=\f[]!infix!5!left
-\f[4]+ -\f[]!infix!6!left
-\f[4]+ -\f[]!prefix!7!right
-\f[4]* /\f[]!infix!8!left
-\f[4]**\f[]!infix!9!right
-\f[4]++ --\f[]!prefix!10!right
-\f[4]++ --\f[]!postfix!11!left
-e1\f[4][\f[]e2\f[4]]\f[]!postfix!12!left-to-right
-mathfn\f[4](\f[]...\f[4])\f[]!!!
+Operators,Class,Precedence,Associativity
+mathfn \f[4]=\f[],prefix,0,right
+\f[4]:= -= += *= /=\f[],infix,1,right,
+\f[4]%= &&= ||= |=\f[],,,
+\f[4]~= &= >>= <<=\f[],,,
+\f[4]or ||\f[],infix,2,left
+\f[4]and &&\f[],infix,3,left
+\f[4]not !\f[],prefix,3,right
+\f[4]= eq eql equal\f[],infix,4,left
+\f[4]!= neq neql nequal\f[],,,left
+\f[4]< > <= >=\f[],infix,5,left
+\f[4]less greater\f[],,,
+\f[4]lequal gequal\f[],,,
+\f[4]|\f[],infix,6,left
+\f[4]~\f[],infix,7,left
+\f[4]&\f[],infix,8,left
+\f[4]<< >>\f[],infix,9,left
+\f[4]+ -\f[],infix,10,left
+\f[4]+ -\f[],prefix,11,right
+\f[4]* / %\f[],infix,12,left
+\f[4]**\f[],infix,139,right
+\f[4]++ --\f[],prefix,14,right
+\f[4]++ --\f[],postfix,15,left
+e1\f[4][\f[]e2\f[4]]\f[],postfix,16,left-to-right
+mathfn\f[4](\f[]...\f[4])\f[],,,
 .TE
 
 In this table,
@@ -54240,23 +54247,66 @@ however, if the prefix operator
 is inserted in front, the resulting expression is then recognized
 as infix by rule 1.
 
+The infix
+.code /=
+operator has the same name as a Lisp function, but a different meaning.
+The Lisp
+.code /=
+calculates numeric inequality: the negation of the
+.code =
+function. The same-named operator performs a division assignment;
+the expression
+.code "(a /= b)"
+is transformed into
+.codn "(div a b)" .
+
 Other than as noted above, in all cases when prefix, infix or postfix
 operators have names which correspond to functions, they are
 transformed to standard syntax by these patterns:
 
 .verb
+  a fn     ->  (fn a)
   a fn b   ->  (fn a b)
     fn b   ->  (fn b)
-  a fn     ->  (fn a)
 .brev
 
 The following operators which are not named directly after Lisp
-macros or functions, are treated according to the following patterns:
+macros or functions, are treated according to the following patterns.
+Where variables
+.code a
+or
+.code b
+appear more than once in these patterns, it is to be understood
+that only a single evaluation takes place:
 
 .verb
   a := b   ->  (set a b)
   a += b   ->  (inc a b)
-  a +- b   ->  (dec a b)
+  a -= b   ->  (dec a b)
+  a *= b   ->  (mul a b)
+  a /= b   ->  (div a b)
+  a &= b   ->  (set a (logand a b))
+  a |= b   ->  (set a (logior a b))
+  a ~= b   ->  (set a (logxor a b))
+  a <<= b  ->  (set a (ash a b))
+  a >>= b  ->  (set a (ash a (- b)))
+
+  a || b   ->  (or a b)
+  a && b   ->  (and a b)
+  ! a      ->  (not a)
+
+  a != b   ->  (/= a b)
+
+  a | b    ->  (logior a b)
+  a ~ b    ->  (logxor a b)
+  a & b    ->  (logand a b)
+
+  a % b    ->  (mod a b)
+  a // b   ->  (floor a b)
+
+  a << b   ->  (ash a b)
+  a >> b   ->  (ash a (- b))
+
     ++ b   ->  (inc b)
     -- b   ->  (dec b)
   a ++     ->  (pinc a)