guile-examples/programs/prefix-to-postfix/main.scm

;; (define flat?
;;   (λ (lst)
;;     (cond
;;      [(null? lst) #t]
;;      [(pair? (car lst)) #f]
;;      [(null? (car lst)) #f]  ; needed because (pair? '()) is #f
;;      [else (flat? (cdr lst))])))

(library (prefix-to-postfix)
  (export arity-lookup-table
          known-operation?
          look-for-next-list
          adapt-arity
          prefix->postfix)
  (import
   (except (rnrs base) let-values map)
   (only (guile)
         lambda* λ
         simple-format
         current-output-port)
   (srfi srfi-69)  ; hash-table
   (srfi srfi-1)  ; lists
   )

  (define arity-lookup-table
    (alist->hash-table
     '((+ . 3)
       (- . 2)
       (* . 2)
       (/ . 2))))


  (define known-operation?
    (λ (op)
      (hash-table-exists? arity-lookup-table op)))


  (define look-for-next-list
    (λ (lst callback)
      "LST is the list which is looked at element by element, to find the
next sublist. CALLBACK is the function called for the next found
sublist."
      (cond
       [(null? lst) '()]
       [(null? (car lst))
        (cons '() (look-for-next-list (cdr lst) callback))]
       [(pair? (car lst))
        (cons (callback (car lst))
              (look-for-next-list (cdr lst) callback))]
       [else
        (cons (car lst)
              (look-for-next-list (cdr lst) callback))])))


  (define adapt-arity
    (λ (lst)
      ;; (+ 1 2 3 4) --> (+ 1 (+ 2 3 4)) --> (+ 1 (+ 2 (+ 3 4)))
      (let ([operation (car lst)])
        (cond
         ;; base case empty list
         [(null? lst) '()]
         [(known-operation? operation)
          (let ([wanted-arity (hash-table-ref arity-lookup-table (car lst))])
            ;; check, if we have sufficient arguments for another "split"
            (cond
             [(<= (length lst) wanted-arity)
              (cons (car lst)
                    ;; But there could still be other operations in the
                    ;; remaining too few arguments, so we need to check,
                    ;; whether they are operations and then adapt their
                    ;; arity as well.
                    (look-for-next-list (cdr lst) adapt-arity))]
             [else
              ;; make a proper list - append takes 2 proper lists as input
              (append
               ;; The list still contains the operation. Take 1 less
               ;; argument than operation arity to keep 1 argument for the
               ;; new call to the operation.
               (take lst wanted-arity)
               ;; Build the last argument, which is a new call to the
               ;; operation with the remaining arguments. However, those
               ;; could be too many, so do a recursive call.
               (list
                (adapt-arity
                 (cons operation
                       (drop lst wanted-arity)))))]))]
         ;; Ignore unrecognized operations. We do not have arity
         ;; information for them, so just leave them as they are.
         [else lst]))))


  (define prefix->postfix
    (λ (lst)
      (cond
       [(null? lst) '()]
       [else
        (append
         ;; "Look for the next sublist and call me back, when you find
         ;; it!"
         (look-for-next-list (cdr lst)
                             prefix->postfix)
         (list (car lst)))])))


  (define (flatten lst)
    (let loop ([remaining-lst lst]
               [acc '()])
      (cond
       [(null? remaining-lst) acc]
       [(pair? remaining-lst)
        (loop (car remaining-lst)
              (loop (cdr remaining-lst)
                    acc))]
       [else
        (cons remaining-lst acc)])))


  (simple-format (current-output-port)
                 "adapted arity: ~a\n"
                 (adapt-arity '(+ 1 2 (- 3 4) 5)))

  (simple-format (current-output-port)
                 "postfix: ~a\n"
                 (prefix->postfix (adapt-arity '(+ 1 2 (- 3 4) 5))))

  (simple-format (current-output-port)
                 "flattened: ~a\n"
                 (flatten (prefix->postfix (adapt-arity '(+ 1 2 (- 3 4) 5))))))