t3x.org / sketchy / prog / prefix.html
SketchyLISP Stuff Copyright (C) 2006 Nils M Holm

prefix

Conformance: sketchy

Purpose: Convert arithmetic expressions in infix notation to S-expressions. Infix expressions are represented by flat lists of variables (atoms) operators (atoms) and numbers (sequences of atoms representing digits).
 
The following operators are recognized: + (addition) - (subtraction), * (multiplication), / (division), ^ (exponentation), and - (negation). Brackets are recoginzed as parentheses.
 
For instance,
(prefix '(57 * [ x + y ]))
gives
(* 57 (+ x y)).

Arguments:
X - arithmetic expression

Implementation:

(define (prefix x)
  (letrec

  ; Operator symbols
  ((+ '+) (- '-) (* '*) (/ '/) (^ '^) ([ '[) (] '])

  (symbol-p (lambda (x)
    (memq x '(a b c d e f g h i j k l m
              n o p q r s t u v w x y z))))

  (digit? (lambda (x) (memq x digits)))

  ; Extract a numeric value from the beginning of X.
  ; Return (N XR) where N is the value extracted and
  ; XR is the rest of X (X with N removed).
  (number (lambda (x r)
    (cond ((null? x)
        (list (reverse r) x))
      ((not (digit? (car x)))
        (list (reverse r) x))
      (#t (number (cdr x) (cons (car x) r))))))

  ; These functions are used to extract parts
  ; of (EXPR REST) lists where EXPR is the prefix
  ; expression built so far and REST is the rest
  ; the source expression to parse
  (car-of-rest caadr)
  (cdr-of-rest cdadr)
  (expr car)
  (rest cadr)

  ; Parse factors:
  ; factor := [ sum ]
  ;   | - factor
  ;   | Number
  ;   | Symbol
  (factor (lambda (x)
    (cond ((null? x) (list x '()))
      ; Parse parenthesized subexpressions
      ((eq? (car x) [)
        (let ((xsub (sum (cdr x))))
          (cond ((null? (rest xsub)) (bottom 'missing-paren))
            ((eq? (car-of-rest xsub) ])
              (list (expr xsub) (cdr-of-rest xsub)))
            (#t (bottom 'missing-paren)))))
      ; Parse applications of unary minuses
      ((eq? (car x) -)
        (let ((fac (factor (cdr x))))
          (list (list '- 0 (expr fac)) (rest fac))))
      ; Parse literal numbers
      ((digit? (car x))
        (number x '()))
      ; Parse symbols
      (#t (list (car x) (cdr x))))))

  ; Parse powers:
  ; power := factor
  ;   | factor ^ power
  (power (lambda (x)
    (let ((left (factor x)))
      (cond ((null? (rest left)) left)
        ((eq? (car-of-rest left) ^)
          (let ((right (power (cdr-of-rest left))))
            (list (list 'expt (expr left) (expr right))
              (rest right))))
        (#t left)))))

  ; Parse terms:
  ; term := power
  ;   | power Symbol
  ;   | power * term
  ;   | power / term
  (term (lambda (x)
    (let ((left (power x)))
      (cond ((null? (rest left)) left)
        ((symbol-p (car-of-rest left))
          (let ((right (term (rest left))))
            (list (list '* (expr left) (expr right))
              (rest right))))
        ((eq? (car-of-rest left) *)
          (let ((right (term (cdr-of-rest left))))
            (list (list '* (expr left) (expr right))
              (rest right))))
        ((eq? (car-of-rest left) /)
          (let ((right (term (cdr-of-rest left))))
            (list (list 'quotient (expr left) (expr right))
              (rest right))))
        (#t left)))))

  ; Parse sums:
  ; sum := term
  ;   | term + sum
  ;   | term - sum
  (sum (lambda (x)
    (let ((left (term x)))
      (cond ((null? (rest left)) left)
        ((eq? (car-of-rest left) +)
          (let ((right (sum (cdr-of-rest left))))
            (list (list '+ (expr left) (expr right))
              (rest right))))
        ((eq? (car-of-rest left) -)
          (let ((right (sum (cdr-of-rest left))))
            (list (list '- (expr left) (expr right))
              (rest right))))
        (#t left))))))

  ; Pass X to the recursive descent parser consisting of
  ; SUM, TERM, POWER, FACTOR. The parsing process returns a
  ; list of the form (EXPR REST) as described above. When the
  ; REST is NIL, the entire expression could be parsed
  ; successfully.
  (let ((px (sum x)))
    (cond ((not (null? (rest px)))
        (bottom (list 'syntax: (cadr px))))
      (#t (expr px))))))

Example:

(prefix '(12 + 34 * 56 ^ [ 7 + 8 ])) 
=> (+ 12 (* 34 (expt 56 (+ 7 8))))