From fed45b6dd4d57e5436e29d9c392c439dd9905e72 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Thu, 12 Sep 2024 00:43:33 +0900 Subject: Fix infix->prefix procedures --- qklib/infix.scm | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/qklib/infix.scm b/qklib/infix.scm index ee58df5..06aab6b 100644 --- a/qklib/infix.scm +++ b/qklib/infix.scm @@ -78,7 +78,12 @@ (list (->prefix left left-op))) (if (and (pair? left) (null? (cdr left))) - (list (car left)) + (if (and not-binary-only? + (operator-left? op) + (pair? (car left)) + (eqv? (operator-symbol op) (car (car left)))) + (cdr (car left)) + (list (car left))) (fail (->infix left op-sym right)))) ,@(if (operator? right-op) (if (and not-binary-only? @@ -88,7 +93,12 @@ (list (->prefix right right-op))) (if (and (pair? right) (null? (cdr right))) - (list (car right)) + (if (and not-binary-only? + (operator-right? op) + (pair? (car right)) + (eqv? (operator-symbol op) (car (car right)))) + (cdr (car right)) + (list (car right))) (fail (->infix left op-sym right))))))) (if (operator-right? op) (let-values (((lst op+rest) (break! (cute eqv? (operator-symbol op) <>) expr))) -- cgit v1.2.3