From c3ce00eb7a886e38a6262ddbb1772cdd8297cb39 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 5 Apr 2025 00:48:58 -0700 Subject: 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. --- stdlib/infix.tl | 37 ++++++++++++++++++++----------------- 1 file 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 -- cgit v1.2.3