LINUX.ORG.RU
Форум — Development  

[Scheme][Lisp][Макры] Есть вопросы.

 ,


0

0

Пишу на PLT.

Хочу написать макры, которые будут транслировать в SQL код.

(require scheme)
(require scheme/list)
(require scheme/base)

(define-syntax ($! stx)
  (syntax-case stx ()
    ((_ x)
     (let ((e (syntax-e #'x)))
       (cond ((string? e) #'x)
             ((symbol? e) #`(symbol->string '#,e))
             ((list? e)
              (let* ((operator (syntax-e (car e)))
                     (args (map (λ (x)
                                  (expand `($! ,(syntax-e x))))
                                (cdr e))))
                (case operator
                  ((and) #`(apply string-append (add-between #,args #'" AND ")))
                  (else #'"s"))))
             (else (error "$!: not implemented")))))
    ((_ x y ...)
     #'(string-append ($! x) " " ($! y ...)))))

(define-syntax $
  (syntax-rules (select from where)
    ((_ select value from source)
     (string-append " SELECT " ($! value)
                    " FROM "   ($! source)))
    ((_ select value from source where conditions ...)
     (string-append " SELECT " ($! value)
                    " FROM "   ($! source)
                    " WHERE "  ($! conditions ...) " "))))

($ select id from med.users where (and a b c))

Хотел получить инфу о syntax-object, узнать строка, или символ, во время раскрытия макроса. Использовал syntax-e, ничего более хорошего не нашёл.

Как я понял, макры всегда должны возвращать syntax-object.

Почему-то не выходит. Что не так?

Надо поменять: 

1. (expand `($! ,(syntax-e x)))) на `($! ,(syntax-e x))
2. #,args на #,(cons 'list args)
3. #'" AND " на " AND "

Должно заработать. В сам код сильно не вникал, но что-то есть большое подозрение что все можно сделать несколько проще.

tarc
()

Вот написал более чистый вариант.

Но тут без гигиены.

(require scheme)
(require scheme/list)
(require scheme/base)

(define (sql-trans args)
  (match args
    ((list 'select x)
     (string-append " SELECT " (sql-trans x) " "))
    
    ((list 'select x
           'from y)
     (string-append " SELECT " (sql-trans x)
                    " FROM "   (sql-trans y) " "))
    
    ((list 'select x
           'where y)
     (string-append " SELECT " (sql-trans x)
                    " WHERE "  (sql-trans y) " "))
    
    ((list 'select x
           'from y 
           'where z)
     (string-append " SELECT " (sql-trans x)
                    " FROM "   (sql-trans y)
                    " WHERE "  (sql-trans z) " "))
    
    ((list-rest 'and x)
     (string-append* (append '("(")
                             (add-between (map sql-trans x) " AND ")
                             '(")"))))
    
    ((list-rest 'or x)
     (string-append* (append '("(")
                             (add-between (map sql-trans x) " OR ")
                             '(")"))))
    
    ((? number? x) (number->string x))
    ((? string? x) x)
    ((? symbol? x) (symbol->string x))))

;;; recursive syntax->datum
(define (make-plain expr)
  (let ((e (syntax-e expr)))
    (if (list? e)
        (map make-plain (syntax->list expr))
        e)))

(define-syntax $
  (syntax-rules ()
    ((_ x) (sql-trans (make-plain #'x)))))
Ruga-Suneto
() автор топика
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.
Development