[racket] More macros...

I posted a few questions about Racket macros a few days ago, and received
many interesting suggestions Neil Van Dyke. Danny Yoo posted a link to a
very interesting blog/book, which was of great help:

http://www.greghendershott.com/fear-of-macros/

I also received programs from Robby Findler,  Sean Kanaley, Marco Maggio,
etc. Since the feedback was so usefull, I decided to ask for more. In fewer
words, I am posting a small program here, and I would like to receive
suggestion on improvements. I wrote a macro that converts infix expressions
to the Cambridge prefix notation. Here are a few examples on how to use it:

#lang racket

(require "infix.rkt")

(define (fibonacci n)
  (if (hp n<2) 1
      (hp fibonacci:(n - 1)+fibonacci:(n - 2))))

(define (app xs ys)
  (if (null? xs) ys
      [hp car:xs cons app:(cdr:xs& ys)]))

One can use the macro on the REPL:

Welcome DrRacket, version 6.0 [3m].
Language: racket [costumized]; memory limit: 256 MB.
> (hp 'lily cons 'rose cons 'orchid cons ())
'(lily rose orchid)
> (hp "Rose" cons "Lily" cons "Orchid" cons ())
'("Rose" "Lily" "Orchid")
> (hp 3 (4+5) 6)
162
> (hp 3*(4+5)*6)
162
> (define (area r) (hp pi r r))
> (area 10)
314.1592653589793
> _

My program has many flaws. I hope to receive a corrected version. For
instance, I don't think that writing the expression into a string in order
to tokenize it is a good idea. I guess there is a better solution in
Racket. I also believe that one can use syntax-case to get some error
handling. In any case, here is the hp-macro:

#lang racket ;; File: infix.rkt
(require (for-syntax racket))

;; Function calls are written thus: expt:(2&3)
;; The arguments are separated by &, since the macro does not
;; accept commas. A call fn:(a&b&c&d) is read thus: (&(& (& a b) c)d)
;; (flat '(&(& (& a b) c)d)) => (a b c d)
(define-for-syntax (flat xs)
    (match xs ['() '()]
       [(list-rest '& a b) (append (flat a)  b)]
       [_ (list xs)]))

;; (w op) produces the precedence of op. For instance,
;; (w '*) produces the precedence of *, whici is 5.
;; right associative operators have negative precedence.
(define-for-syntax (w s) (case s
    [(&) 0] [(or) 1] [(and) 2]
    [(< = > <= >=) 3]
    [(cons) -3] [(:) -7]
    [(+ -) 4] [(* /) 5] [(^) 6]
    [else 9]))

;; Multiplication can be achieved by * or by juxtaposition.
;; (times? x) checks juxtaposition
(define-for-syntax (times? x) (or (pair? x) (= (w x ) 9)))

;; e contains the infix expression, that will be consumed by the algorithm
;; o contains the operator stack
;; a builds the prefix expression.
;; I found this algorithm in an old Lisp book, by Winston and Horn
(define-for-syntax (pri e o a)
    (define (p? ox)
        ((if (< (w ox) 0) >= >) (abs (w (car e))) (abs (w ox))))
    (match/values (values e o a)
       [('() '() (cons x _)) x]
       [[(cons (? times?) _) _ _ ] (pri (cons '* e) o a)]
       [[ (list-rest x y es) (or '() (cons (? p?) _)) _]
         (pri es (cons x o) `(,(pre y) , at a))]
       [[_ (cons ': ops) (list-rest (cons '& _) y args)]
        (pri e ops `((,y ,@(flat (car a))) , at args))]
       [[_ (cons ': orest) (list-rest ax ay arest)]
        (pri e orest `((,ay ,ax) , at arest))]
       [[_ (cons ox orest) (list-rest ax ay arest)]
        (pri e orest `( (,ox ,ay ,ax) , at arest))]))

;; if x is not pair?, (pre x) produces x
;; if x is a quoted expression, (pre x) produces x
;; otherwise, (pre x) calls (pri (cdr x) '() (pre (car x)) )
;; to produce the prefix notation.
(define-for-syntax (pre x)
  (cond [ (not (pair? x)) x]
        [ (equal? (car x) 'quote) x]
        [else (pri (cdr x) '() (list (pre (car x))))]))

;; (tokenize xpr) has a misleading name.
;; In fact, it reads an sexpr representation of the infix expression.
;; For instance, if xpr= '("3" "*" "(" "4" "+" "5" ")" "*" "6"),
;; (tokenize xpr) produces '(3 * (4 + 5) * 6);
;; the list of string tokes is saved in s, that is destructively
;; updated by the algorithm.  I wrote an error handling version,
;; but I decided to leave this kind of complication out of the
;; algorithm.
(define-for-syntax (tokenize xpr) (let [(s '())]
   (define (rdit) (match s
       [ '() (error "Unexpected end of input")]
       [ (list-rest "'" y resto)
         (list 'quote  (rdit))]
       [ (cons (and head (regexp #rx"^\"")) tail) (set! s tail)
          (substring head 1 (- (string-length head) 1))]
       [ (list-rest "(" ")" tail) (set! s tail) (list 'quote  '())]
       [ (cons "(" tail) (set! s tail)
         (rdlist (~a  s #:max-width 30))]
       [ (cons ")" _)(error "Unmatched `)'")]
       [ (cons "#f" tail) (set! s tail) '#f]
       [ (cons "#t" tail) (set! s tail) '#t]
       [ (cons (and head (? string->number)) tail) (set! s tail)
         (string->number head)]
       [ (cons head tail) (set! s tail) (string->symbol head)]   ))

;; Here one reads the tail of the sexpr.
(define (rdlist callee)
     (match s ['()   (error "Unexpected end of list")]
        [(cons ")" tail) (set! s tail) '()]
        [_  (cons (rdit) (rdlist callee))] ))

   ;; below, one tokenizes xpr, and calls (rdit)
   (set! s (separate xpr)) (rdit)))

;; regexpr to tokenize x
(define-for-syntax (separate x) (regexp-match*
   (regexp (string-append "\"[^\"]+\"|#t|#f|[a-z]+->[a-z]+"
           "|-?[0-9]+\\.?[0-9]*e-?[0-9]+"
               "|[a-z?A-Z~-]+[0-9-]*"
               "|-?[0-9]+\\.?[0-9]*|;[a-z]+/?[a-z]*"
               "|<=|>=|[][()'&;*:<>=+/^-]")) x))

;; Below you will find two things that I don't like in
;; this solution. Since I don't want mandatory white space
;; around tokens, I write the infix expression into a string.
;; Then I tokenize the string, and read it back as an
;; sexpr. For instance, let us assume that one enters
;; (hp 3*4+5*6). There is no spaces around the operators.
;; The hp macro writes everything into a string: xpr= "3*4+5*6";
;; (tokenize xpr) reads this string back as an sexpr: (3 * 4 + 5 * 6).
;; (pre (tokenize xpr)) puts the expression into the prefix form.
(define-for-syntax (tkn stx) (with-output-to-string (lambda()
                             (write (cdr (syntax->datum stx))) )))

(define-syntax (hp stx)
  (datum->syntax stx (pre (tokenize (tkn stx)) )))

(provide hp)

;; Here is what I hope to get from the list members:
;; 1) A way to avoid writing the expression into a string
;;      before tokenizing it. I am not sure whether this is
;;      possible. By the way, I would like to have a macro
;;      solution, like the one Mark Kantrowitz wrote for Lisp.
;;      This means that I don't want to create a #lang infix,
;;      or something like that.
;;
;; 2) I also want to avoid datum->syntax, since this is
;;      the general recommendation in this user list.
;;     I believe that it is quite easy to use syntax case,
;;     since the algorithm is based on matching subexpressions.

;; Sorry for this long posting.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20140504/35f4d079/attachment.html>