LINUX.ORG.RU

Scheme: syntax-rules . Должно быть что-то совсем простое, но не догоню - как...


0

1

Хочу сделать регексы в стиле Tcl - т.е.

regex pattern text match var1 var2...

Т.е. если регекс матчится, то в переменные var1 var2 ...автоматически присваиваются распознанные куски () из паттерна. Пишу такое:

(use-modules (ice-9 regex))
(use-modules (ice-9 syncase))

(define (natural-seq) (let ((i 0)) (lambda () (set! i (+ i 1)) i)))

(define-syntax match-vars
 (syntax-rules ()
  ((_ pattern sample match* ...)
   (let ((match-str (string-match pattern sample)))
    (if match-str
     (let ((ser-num (natural-seq)))
      (begin
       (for-each (lambda (sym)
                        (let* ((idx (ser-num))(range (vector-ref match-str idx))(val (substring sample (car range)(cdr range))))
(set! sym val)
'(match* ...))
#t)) #f)))))

А включаешь - не работает. Проблема в том, что (set! sym val) присваевает значение в локальную переменную sym, а не в переменную, идентификатор которой этот sym в данный момент содержит...

Тут что-то простое, наверное, только что именно - не пойму никак...

Поможите кто чем сможет?

(define-syntax match-vars
 (syntax-rules ()
   ((_ pattern sample match* ...)
    (let ((match-str (string-match pattern sample)))
      (and match-str
           (let ((ser-num (natural-seq)))
             (let ((idx (ser-num))
                   (range (vector-ref match-str idx))
                   (val (substring sample (car range)(cdr range))))
               (set! match val) #t) ...))))))

как-то так? только это не scheme-way. лучше использовать let вместо set!.

anonymous ()
Ответ на: комментарий от anonymous

Неа... Не работаеть...

ERROR: extra ellipsis in syntax form (syntax (let ((match-str (string-match pattern sample))) (and match-str (let ((ser-num (natural-seq))) (let ((idx #) (range #) (val #)) (set! match val) #t) ...))))

Вообще - вот эта конструкция какая-то стремная:

(set! match val) #t) ...

Там же по идее - должен быть список идентификаторов переменных, куда надо разложить заматченные куски из sample. Т.е.:

(define match "")
(define lyrName "")
(define text "LAYER M1")
(define pattern "LAYER ([a-zA-Z][a-zA-Z0-9_]*)")

(if (match-vars pattern text match lyrName) 
 (format #t "Recognized layer name: '~a'\n" lyrName)
 (format #t "Fail\n"))



Т.е. список идентификаторов должен синтаксическим рулом быть развернут в совокупность (set! var_i val_i) - вопрос именно - как это сделать....
Flogger_d ()
Последнее исправление: Flogger_d (всего исправлений: 1)
Ответ на: комментарий от Flogger_d

Там опечатка, надо (set! match val) #t) поменять на (set! match* val) #t). Звездочку забыл.

Вообще - вот эта конструкция какая-то стремная:

там другая конструкция, вот такая:

(let ((idx (ser-num))
                   (range (vector-ref match-str idx))
                   (val (substring sample (car range)(cdr range))))
               (set! match* val) #t) ...
... для всего этого let-выражения.

Т.е. список идентификаторов должен синтаксическим рулом быть развернут в совокупность (set! var_i val_i) - вопрос именно - как это сделать....

Именно так как это сделано у меня выше.

Вообще лучше бы почитал спеки для pattern-language в syntax-rules и все вопросы были бы сняты. Алсо - какая конкретно схема используется?

anonymous ()

попробуй как то так:

(use-modules (ice-9 regex))
(use-modules (ice-9 syncase))

(define-syntax match-vars
  (syntax-rules ()
    ((_ pattern sample-expr id0 id1 ...)
     (let* ([sample sample-expr]
            [match-result (string-match pattern sample)])
     (if match-result
         (let* ([idx 0]
                [get-next-val (lambda ()
                                (let ([range (vector-ref match-result idx)])
                                  (set! idx (+ idx 1))
                                  (substring sample (car range)(cdr range))))])
           (set! id0 (get-next-val))
           (set! id1 (get-next-val)) ...)
         #f))))
qaqa ()
Ответ на: комментарий от qaqa

маленькое исправление:

(use-modules (ice-9 regex))
(use-modules (ice-9 syncase))

(define-syntax match-vars
  (syntax-rules ()
    ((_ pattern sample-expr id0 id1 ...)
     (let* ([sample sample-expr]
            [match-result (string-match pattern sample)])
     (if match-result
         (let* ([idx 0]
                [get-next-val (lambda ()
                                (let ([range (vector-ref match-result idx)])
                                  (set! idx (+ idx 1))
                                  (substring sample (car range)(cdr range))))])
           (set! id0 (get-next-val))
           (set! id1 (get-next-val)) ...)
         (error "match error!")))) ;; ошибка если сопоставить не удалось[/scheme]

qaqa ()
Ответ на: комментарий от qaqa

Так! Большое спасибо. Хотя приведенный код и не заработал «As is», он натолкнул на правильную идею. Конечный вариант, который заработал у меня:

(define-syntax match-vars
 (syntax-rules ()
  (
   (match-vars re sample m ...)
   ((let ((match-str (string-match re sample))).
    (if match-str.
     (let* ((idx 0).
            (get-next-value.
             (lambda ().
              (set! idx (+ idx 1))
              (let ((range (vector-ref match-str idx)))
               (substring sample (car range)(cdr range))))))
      (begin
       (set! m (get-next-value)) ...
       (lambda () #t))) (lambda () #f))))
  )
 )
)

Да, я пользуюсь guile 1.8.7

Flogger_d ()
Последнее исправление: Flogger_d (всего исправлений: 1)
Ответ на: комментарий от Flogger_d

guile не пользуюсь, код не запускал.

Может не в курсе, но шаблон syntax-rules

m ...
соответствует нулю или более элементов, поэтому, чтобы гарантировать хотя бы один элемент пишут
m0 m ...
ну и это соответственно приводит к
(set! m0 (get-next-value))
(set! m (get-next-value)) ...
Вот это:
(let* ([sample sample-expr]
зря убрали: если sample является выражением, оно будет вычислено (в вашем случае) дважды.

qaqa ()
Ответ на: комментарий от qaqa

Вообще все переделал, чтобы было удобнее. Теперь так:

(use-modules (ice-9 regex))
(use-modules (ice-9 syncase))

(define re "LAYER\\s+([a-zA-Z][a-zA-Z0-9_]*)")
(define sample "LAYER M1")

(define (make-next-match match) 
 (let ((idx 0)) 
	(lambda ()
	 (set! idx (+ idx 1))
	 (let ((range (vector-ref match idx)) (sample (vector-ref match 0)))
	  (substring sample (car range)(cdr range))))))


(define-syntax with-matched
 (syntax-rules () 
	((_ (var0 var ...) expr ... )
	 (lambda (match) 
		 (let* ( (next-match (make-next-match match))
                           (var0 (next-match)) (var (next-match)) ...
                         )	expr ... )))))


(cond 
 ((string-match re sample) =>
  (with-matched (m lyrName) (format #t "Recognized LAYER statement: layer name is '~a'\n" lyrName)))
 (else (format #t "No match at all\n")))

Flogger_d ()
Последнее исправление: Flogger_d (всего исправлений: 2)
Ответ на: комментарий от Flogger_d

Может быть и удобнее, но только забыли про sample:

(use-modules (ice-9 regex))
(use-modules (ice-9 syncase))

(define re "LAYER\\s+([a-zA-Z][a-zA-Z0-9_]*)")
(define sample "LAYER M1")

(define (make-next-match sample match) 
  (let ((idx 0)
        (sample sample)) 
    (lambda ()
      (set! idx (+ idx 1))
      (let ((range (vector-ref match idx)) (sample (vector-ref match 0)))
        (substring sample (car range)(cdr range))))))

(define-syntax with-matched
  (syntax-rules () 
    ((_ sample (var0 var ...) expr ... )
     (lambda (match) 
       (let* ((next-match (make-next-match sample match))
              (var0 (next-match)) (var (next-match)) ...)
         expr ... )))))

(cond 
  ((string-match re sample)
   => (with-matched sample (m lyrName) (format #t "Recognized LAYER statement: layer name is '~a'\n" lyrName)))
  (else (format #t "No match at all\n")))
А иначе нельзя повторно использовать.

qaqa ()
Ответ на: комментарий от qaqa

Я бы как то так сделал (код не запускал, может где ошибся):

(use-modules (ice-9 regex))
(use-modules (ice-9 syncase))

(define re "LAYER\\s+([a-zA-Z][a-zA-Z0-9_]*)")
(define sample "LAYER M1")

(define (string-match/thunk re sample)
  (let ((result (string-match re sample)))
    (cond
      (result (let ((idx 0))
                (lambda ()
                  (set! idx (+ idx 1))
                  (let ((range (vector-ref result idx)))
                    (substring sample (car range) (cdr range))))))
      (else #f))))

(define-syntax with-thunk-results
  (syntax-rules () 
    ((_ (var0 var ...) expr ... )
     (lambda (thunk) 
       (let* ((var0 (thunk))
              (var (thunk)) ...)
         expr ... )))))

(cond 
  ((string-match/thunk re sample)
   => (with-thunk-results (m lyrName)
         (format #t "Recognized LAYER statement: layer name is '~a'\n" lyrName)))
  (else (format #t "No match at all\n")))

qaqa ()
Ответ на: комментарий от qaqa

Ну, это уже косметика. Полировать можно до бесконечности, а главное - это нужно делать исходя из опыта использования в реальных прототипах кода. Самое главное - я разобрался с сутью syntax-rules. И да - спасибо за интересную дискуссию.

Flogger_d ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.