diff options
Diffstat (limited to 'qklib')
| -rw-r--r-- | qklib/infix.scm | 28 |
1 files 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)) |