infix: revise auto-detection.

* stdlib/infix.tl (parse-infix): Drop usr: package
prefix; autoload.c interns this symbol in the usr
package.
(detect-infix): New function, whose single
responsibility is determining whether the argument
expression should be treated via parse-infix.
(infix-expand-hook): Simplified by using detect-infix
function.

1 files changed, 20 insertions, 17 deletions

diff --git a/stdlib/infix.tl b/stdlib/infix.tl
index e1e801bb..3d83a6a1 100644
--- a/stdlib/infix.tl
+++ b/stdlib/infix.tl
@@ -96,7 +96,7 @@
         (put-line msg *stderr*))
       (throw 'eval-error msg))))
 
-(defun usr:parse-infix (exp)
+(defun parse-infix (exp)
   (let (nodestack opstack (ucheck t) (oexp exp))
     (flet ((add-node (oper)
               (ecaseql oper.arity
@@ -158,22 +158,25 @@
       (infix-error oexp "nodestack extra entries ~s" nodestack))
     (first nodestack)))
 
-(defun-match infix-expand-hook
-  ((@exp @nil :macro)
-   exp)
-  ((@(as exp (@[ifx-uops] @nil [. @nil] . @nil)) @nil @nil)
-   (usr:parse-infix exp))
-  ((@(as exp (@[ifx-uops] @nil . @rest)) @nil @nil)
-   (if (find-if [orf ifx-uops ifx-ops] rest)
-     (usr:parse-infix exp)
-     exp))
-  ((@(as exp (@x @y . @rest)) @nil @nil)
-   (cond
-     ((or [ifx-uops y] [ifx-ops y]) (usr:parse-infix exp))
-     ((find-if [orf ifx-uops ifx-ops] rest) (usr:parse-infix exp))
-     ((and (not (fboundp x)) (fboundp y)) ^(,y ,x ,*rest))
-     (t exp)))
-  ((@exp @nil @nil) exp))
+(defun-match detect-infix
+  (((@(@o [ifx-uops]) . @rest))
+   (or (neq o.sym o.lispsym)
+       (find-if [orf ifx-uops ifx-ops] rest)))
+  (((@nil @y . @rest))
+   (or [ifx-uops y] [ifx-ops y]
+       (find-if [orf ifx-uops ifx-ops] rest)))
+  ((@nil)))
+
+(defun infix-expand-hook (exp env type-sym)
+  (ignore env)
+  (cond
+    ((eq type-sym :macro) exp)
+    ((detect-infix exp) (parse-infix exp))
+    (t (if-match (@(require (@x @y . @rest)
+                            (and (not (fboundp x)) (fboundp y))))
+                 exp
+          ^(,y ,x ,*rest)
+          exp))))
 
 (defmacro usr:ifx (. body)
   ^(expander-let ((*expand-hook* [expand-hook-combine infix-expand-hook