prefix notation and () on newRPL project

[Albert Chan]

For completeness, this is my attempt for infix-to-prefix calc macro, for Chez Scheme

Note: the code scan tokens in reverse, from right to left.
This simplified code to use stack only for (* /)

(calc whatever +/- x) ⇒ (+/- (calc whatever) x)     ; unary ± has higher precedence than infix ±
(calc whatever x ^ y) ⇒ (calc whatever (^ x y))     ; ^ has associativity right to left

Code:

(define ^ expt)
(define calc-aux #f)
(let ()
  (define (calc-obj obj)
    (if (atom? (syntax->datum obj)) obj
        (calc-aux (syntax->list obj))))

  (define (1st e)  (calc-obj (car e)))
  (define (2nd e)  (calc-obj (cadr e)))
  (define (op e)   (syntax->datum (car e)))
  (define (process e)   (scan (cdr  e) (1st e) '()))
  (define (rest e) (scan (cddr e) (2nd e) '()))
  (define (do-term a term) [set-car! (cdr term) a] term)
  (define (build a term) [fold-left do-term a term])

  (define (scan e a term)      ; work with reversed expression e
    (if (null? e) (build a term)
      (case (op e)
        ((+ -)  (if (null? (cdr e))
                    (build [list (car e) a] term)  ; unary +/-
                    (if (memq (op (cdr e)) '(+ - * / ^))
                        (scan (cdr e) [list (car e) a] term)  ; op +/-
                        (list (car e) [rest e] (build a term)))))
        ((* /)  (scan (cddr e) (2nd e) [cons [list (car e) #f a] term]))
        ((^)    (scan (cddr e) [list (car e) (2nd e) a] term))
        (else   (scan (cdr  e) (1st e) [cons [list #'* #f a] term])))))

  (set! calc-aux
    (lambda (e)
      (if (eq? (op e) '@)
        (cons (cadr e) (map calc-obj (cddr e))) ; (@ f ...) -> (f ...)
        (process (reverse e))))))

(define-syntax (calc stx)
  (syntax-case stx ()
    ((calc a ...) (calc-aux #'(a ...)))))

scheme> (load "calc.ss")
scheme> (calc - 2 ^ 3 ^ 4)     ; = - (2 ^ (3 ^ 4))
-2417851639229258349412352
scheme> (calc - (2 ^ 3) ^ 4)
-4096

scheme> (calc 1 + 2 3 4)       ; implied multiply
25
scheme> (define (calc-expand s) (syntax->datum (calc-aux (syntax->list s))))
scheme> (calc-expand #'(1 + 2 3 4))
(+ 1 (* (* 2 3) 4))

scheme> (define phi (calc (1 + (@ sqrt 5)) / 2))
scheme> (define (fib n) (calc (phi ^ n - (1 - phi) ^ n) / (@ sqrt 5)))
scheme> (fib 10)
55.000000000000014
scheme> (fib 20)
6765.000000000005

calc macro had unary (+ -) between binary (* /) and (+ -), similar to Fortran 77
see http://macnauchtan.com/pub/precedence.html#_Fortran

---

2024/11/4:

1. added unary +/- feature (next post)

scheme> (calc-aux '(- 3 * + 4 ^ - 5))
(* (- 3) (+ (^ 4 (- 5))))

2. added recursing into @ function arguments

scheme> (calc (@ sqrt
(5 *(((((1 + .2 *(350 / 661.5)^ 2)^ 3.5 - 1)*
(1 - 6.875E-6 * 25500)^ - 5.2656)+ 1)^ .286 - 1))))

0.8357245351752515