File ``infix_to_prefix.scm''

;;--------------------------------------------------------------------------
;; AriNET Project in Informatics IA by Dominique Guinard
;; dominique.guinard@unifr.ch
;;--------------------------------------------------------------------------
;; Infix to prefix
;;
;; Adapted from the source code of :
;; Autor:    Lehmann Norbert + Jungo Dominik
;; Datum:    16.10.2002
;; Filename: InfixToPrefix.scm
;;--------------------------------------------------------------------------

; ------------------------------------------------------------
; ABSTRACT:
; *********
; The aim of this function is to convert an Infixed expression
; into a Prefixed expression.
; For exemple: (a + b = c) becomes (= (+ a b) c)
; ------------------------------------------------------------

;(load "myeval.scm")

(define (infix->prefix expr)
  (cond ((atom-infix? expr) expr)
        ((and (null? (cdr expr))
              (list? (car expr))) (infix->prefix (car expr)))
        (else (inf-aux expr '() '()))))

(define (inf-aux expr operators operands)
  (cond ((and (null? expr)
              (null? operators)) (car operands))
        ((and (not (null? expr))
              (not (operator? (car expr))) 
              (not (module? (car expr))))
         (inf-aux (cdr expr) operators
                             (cons (infix->prefix (car expr)) operands)))
        ((and (not (null? expr))
              (not (module? (car expr)))
              (or (null? operators)
                  (> (priority (car expr))
                     (priority (car operators)))))
         (inf-aux (cdr expr) (cons (car expr) operators) operands))
        
        ((and (not (null? expr))
              (module? (car expr)))
         (module->prefix expr))
        
        
        (else
         (inf-aux expr
                  (cdr operators)
                  (if (= (arity (car operators)) 1)
                      (cons (list (car operators) (car operands))
                            (cdr operands))
                      (cons (list (car operators) (cadr operands) (car operands))
                            (cddr operands)))))))

(define (atom-infix? item)
  (not (list? item)))

(define (priority operator)
  (case operator
    ((=) 0)
    ((+ -) 1)
    ((* /) 2)
    ((sin cos tan arcsin arccos arctan sqr sqrt exp ln) 3)
    (else 9)))


(define (arity operator)
  (case operator
    ((= + - * /) 2)
    ((sin cos tan arcsin arccos arctan sqr sqrt exp ln) 1)
    ((doubler tripler) 4)
    (else 0)))

(define (operator? expr)
  (member expr '(= + - * / sin cos tan arcsin arccos arctan sqr sqrt exp ln)))

; ------------------------------------------------------------
; modules functions 
;
; (to handle the special case of modules in infix->prefix)
; ------------------------------------------------------------

(define (module? expr)
  (member expr *MODULES*))

(define (module->prefix expr)
  (cond ((null? expr) expr)
        ((module? (car expr))
                  (cons (car expr) (module->prefix (cdr expr))))
        (else
         (cons (infix->prefix (car expr))
               (module->prefix (cdr expr))))))

; ------------------------------------------------------------
; end of modules functions
; ------------------------------------------------------------


; ------------------------------------------------------------
; tests
; ------------------------------------------------------------

;(define test '((doubler a) + (tripler b c) + (tripler (d + e) f) = g))
;(define *MODULES* '(anne hello doubler))
;(infix->prefix '(a + (anne (b * c) (+ a 5) (+ z 5)) = d))
;(infix->prefix '(anne (b * c) (a + 5)))


; ------------------------------------------------------------
; end of tests
; ------------------------------------------------------------

;;--------------------------------------------------------------------------
;; end of infix to prefix
;;--------------------------------------------------------------------------