RE: [NOISE] Curly braces [was Re: Curl]

[Morgan McGuire <address@hidden>]

--- Tim Hickey <tim@cs.brandeis.edu> wrote:
> Would it be difficult to write a "matheval" macro in Scheme
> or Lisp that evaluates arithmetic expressions in infix notation

I'm sure it's been done before (although I couldn't find a nice macro
on Google), but FYI here's one I just whipped up for PLT Scheme since I
hate the (x . > . y) notation.

So, yes.

-m


(require-library "functio.ss")

;; infix->prefix: '(iexp) -> pexp
;;
;; Recursive descent infix parser for Scheme.  Used to implement
;; the infix macro.
;; 
;; iexp: iexp op iexp | unop iexp | symbol | number | (iexp)
;; pexp: number | symbol | (op pexp pexp) | (unop pexp) 
;; op:   + | * | - | / | ^ | > | < | = | <= | >= | and | or
;; unop: sqrt | cos | sin | tan | - | not | +
;;
;; Morgan McGuire
;; morgan@cs.brown.edu
(define (infix->prefix iexp)
  (if (not (list? iexp))
      
      (error 'infix->prefix "Argument must be a parse-tree")
      
      (letrec
        ;; The operator precedence rules.  Lowest precedence is first.
        ;; Operators of equal precedence are on the same line.  All
operators
        ;; must be binary; unary minus and not are handled specially
within
        ;; the parser.  Note that you may not call prefix functions
within
        ;; an infix form; the parser wouldn't know what to do. 
        ([precedence '((> < >= <= =)
                      (+ - or)
                      (* / and)
                      number-or-variable)]
         
         [unary-operator '(- + not sqrt cos sin tan)]
                                 
        ;; peek-token: void -> token
        [peek-token (lambda () (first tokens))]
        
        ;; pop-token: void->token
        ;; Removes a token.
        [pop-token (lambda ()
                     (let ([t (first tokens)])
                       (begin
                         (set! tokens (rest tokens))
                         t)))]
        
        
        ;; more-tokens?: void -> bool
        [more-tokens? (lambda () (not (empty? tokens)))]
        
        ;; while: (void->bool) x (void->void) -> void
        ;; Repeats body while test returns true.
        [while (lambda (test? body)
                 (if (test?) 
                     (begin
                       (body)
                       (while test? body))))]
               
        ;; parse-infix: (list operator) x (list (list operator)) ->
pexp
        ;; low is a set of equally low precedence operators, high-set
is a list of
        ;; lists of higher precedence operators.
        [parse-infix 
         (lambda (low high-set)
           (if (eq? low 'number-or-variable)
               
               (let ([left (pop-token)])
                 
                 ;; At the highest precedence, just return the next
token or expression
                 (cond 
                   ;; Parenthesized expression; recursively parse it
                   [(list? left)        (infix->prefix left)]
                     
                   ;; Unary operator
                   [(memq left unary-operator) `(,left ,(parse-infix
low high-set))]

                   ;; Number or symbol
                   [else left]))
                   
               ;; At this level of precedence, parse two higher level
expressions and
               ;; combine them.
               (let ([left (parse-infix (first high-set) (rest
high-set))])
                 (begin
                   (while (lambda () (and (more-tokens?) (memq
(peek-token) low)))
                          (lambda () 
                            (let* ([operator (pop-token)]
                                   [right    (parse-infix (first
high-set) (rest high-set))])
                              (set! left `(,operator ,left ,right)))))
                   left))))]
        
        [tokens iexp]) 
        
        (parse-infix (first precedence)
                     (rest precedence)))))


;; Infix math macro for PLT MzScheme and DrScheme/(full Scheme mode).
;; Only grouping parens and the following functions are supported in
infix form:
;;
;;  +  *  -  /  ^  >  <  =  <=  >= (and) (or) sqrt cos sin tan  not
;;
;; Morgan McGuire
;; morgan@cs.brown.edu
(define-macro infix (lambda (a . b) (infix->prefix (cons a b))))

=====
Morgan McGuire  
morgan3d@yahoo.com


__________________________________________________
Do You Yahoo!?
Buy the perfect holiday gifts at Yahoo! Shopping.
http://shopping.yahoo.com