From 5d7b567b752bf0ecc060c5636d6461ad34ad602e Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Fri, 30 Aug 2024 01:30:38 +0900 Subject: Fix infix->prefix procedure for the `(op x y)` case. --- qklib/infix.scm | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/qklib/infix.scm b/qklib/infix.scm index 4715a3a..473aed5 100644 --- a/qklib/infix.scm +++ b/qklib/infix.scm @@ -82,19 +82,21 @@ expr)) (define (infix->prefix-1 expr ops) - (let ->prefix ((expr (replace-operators expr ops))) ;; all new conses - (define op (minimum-precedence expr)) - (cond ((operator? op) - (if (operator-left? op) - (let ((rev-expr (reverse! expr))) - (let-values (((rev-lst op+rev-rest) (break! (cut operator=? op <>) rev-expr))) - (let-values (((op rev-rest) (car+cdr op+rev-rest))) - (list (operator-symbol op) (->prefix (reverse! rev-rest)) (->prefix (reverse! rev-lst)))))) - (let-values (((lst op+rest) (break! (cut operator=? op <>) expr))) - (let-values (((op rest) (car+cdr op+rest))) - (list (operator-symbol op) (->prefix lst) (->prefix rest)))))) - ((single? expr) (car expr)) - (else expr)))) + (if (not (pair? expr)) + expr + (let ->prefix ((expr (cons (car expr) (replace-operators (cdr expr) ops)))) ;; all new conses + (define op (minimum-precedence (cdr expr))) + (cond ((operator? op) + (if (operator-left? op) + (let ((rev-expr (reverse! expr))) + (let-values (((rev-lst op+rev-rest) (break! (cut operator=? op <>) rev-expr))) + (let-values (((op rev-rest) (car+cdr op+rev-rest))) + (list (operator-symbol op) (->prefix (reverse! rev-rest)) (->prefix (reverse! rev-lst)))))) + (let-values (((lst op+rest) (break! (cut operator=? op <>) expr))) + (let-values (((op rest) (car+cdr op+rest))) + (list (operator-symbol op) (->prefix lst) (->prefix rest)))))) + ((single? expr) (car expr)) + (else expr))))) (define (single? x) (and (not (null? x)) -- cgit v1.2.3