diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2025-04-04 20:31:02 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2025-04-04 20:31:02 -0700 |
| commit | 0c1d77905b897f2c6f98e0a67f4f9f495b6fb622 (patch) | |
| tree | 736b3b13fdf3cd58c0f14c0e6d75c59fe745d0bd | |
| parent | 7876eaffd6f86cc0dd7a3909051f637d39361798 (diff) | |
| download | txr-0c1d77905b897f2c6f98e0a67f4f9f495b6fb622.tar.gz txr-0c1d77905b897f2c6f98e0a67f4f9f495b6fb622.tar.bz2 txr-0c1d77905b897f2c6f98e0a67f4f9f495b6fb622.zip | |
infix: dynamic precedence algorithm
We implement a dynamic precedence algorithm whereby
when an infix operator is immediately followed by
a clump of one or more consecutive prefix operators,
the infix operator's precedence is lowered to one
less than the lowest one of the prefix operators.
This creates nice handling for situations like
(sqrt x + y - sqrt z + w) whose visual symmetry
parses into (- (sqrt (+ x y)) (sqrt (+ z w)))
rather than subordinating the second sqrt to the
first one.
* stdlib/infix.tl (parse-infix): Before processing
an infix operator, calculate the prefix of the rest
of the input that consists of nothing but consecutive
prefix operators, and if it is nonempty, then use it
to adjust the effective precedence used for the infix
operator. This algorithm must only ever lower the
precedence, never raise it.
| -rw-r--r-- | stdlib/infix.tl | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/stdlib/infix.tl b/stdlib/infix.tl index e45560aa..b08f6c90 100644 --- a/stdlib/infix.tl +++ b/stdlib/infix.tl @@ -109,14 +109,19 @@ (set exp ^((,op ,arg ,*args) ,*rest))) ((@[[chain ifx-uops .?funp] @op] () . @rest) (set exp ^((,op) ,*rest))) - ((@(@o1 [(if ucheck ifx-uops ifx-ops)]) . @rest) + ((@(with @(@o1 [(if ucheck ifx-uops ifx-ops)]) @prec o1.prec) . @rest) (unless (or rest (eq o1.arity :postfix)) (infix-error oexp "operator ~s needs right operand" o1.sym)) + (if (eq o1.arity :infix) + (iflet ((uo [take-while ifx-uops rest])) + (set prec (min prec + (pred (find-min-key uo : + (opip ifx-uops .prec))))))) (if (meq o1.arity :infix :postfix) (whilet ((o2 (first opstack)) (yes (when o2 (caseq o2.assoc - (:left (>= o2.prec o1.prec)) - (:right (> o2.prec o1.prec)))))) + (:left (>= o2.prec prec)) + (:right (> o2.prec prec)))))) (pop opstack) (add-node o2))) (cond |