Gauche:変更手続きへの変換

変更手続きへの変換

線形更新 (Scheme:LinearUpdate) な手続きを、
変更手続き (mutation procedure (R7RS 1.3.5)) に変換するマクロを考えてみました。
(マクロは手続きではないですが)

reverse!!1 は、reverse! の第1引数を変更するようにしたものです。

!!1 ～ !!3 は、手続き名を指定可能にしたものです。それぞれ第1引数～第3引数を変更します。

!! は、「どちらも ! でまぎらわしい ! 」くらいの意味です。

後から戻り値の使用が必要と分かって、修正箇所が多いときに使ってみてください。
(自分のことですが。。。)

;; convert linear update to mutation procedure

(use srfi-1)

(define-syntax reverse!!1
  (syntax-rules ()
    ((_ x1 rest ...)
     (set! x1 (reverse! x1 rest ...)))))

(define-syntax !!1
  (syntax-rules ()
    ((_ proc x1 rest ...)
     (set! x1 (proc x1 rest ...)))))

(define-syntax !!2
  (syntax-rules ()
    ((_ proc x1 x2 rest ...)
     (set! x2 (proc x1 x2 rest ...)))))

(define-syntax !!3
  (syntax-rules ()
    ((_ proc x1 x2 x3 rest ...)
     (set! x3 (proc x1 x2 x3 rest ...)))))

;; test

(define list1 (list 1 2 3 4 5))
(define list2 (list 1 2 3 4 5))
(define list3 (list 1 2 3 4 5))
(define list4 (list 1 2 3 4 5))

(reverse!!1 list1)
(!!1 reverse! list2)
(!!2 map! + list3 (make-list 5 1))
(!!3 map! + (make-list 5 1) list4)

(print list1)
(print list2)
(print list3)
(print list4)

hamayama(2018/10/30 11:34:29 UTC)

• Shiro(2018/10/31 02:56:55 UTC): コンパクトでgoodと思いますが、もし多少冗長になっても 良いのならupdate!もあります。

  (update! list2 reverse!)
  (update! list3 (cut map! + <> (make-list 5 1)))
  

  等。

もう少し考えて、一括して定義ができるようにしてみました。

(define-!!s (変更手続き名1 線形更新手続き名1 変更引数番号1) (変更手続き名2 線形更新手続き名2 変更引数番号2) ...)

変更する引数の番号は、1～3 のみ対応しています。

;; convert linear update to mutation procedure v2.2

(use srfi-1)

(define-syntax define-!!s
  (syntax-rules ()
    ((_ (name-mut name-lin 1) rest-group ...)
     (begin
       (define-syntax name-mut
         (syntax-rules ooo ()
           ((_ x1 rest ooo)
            (set! x1 (name-lin x1 rest ooo)))))
       (define-!!s rest-group ...)))
    ((_ (name-mut name-lin 2) rest-group ...)
     (begin
       (define-syntax name-mut
         (syntax-rules ooo ()
           ((_ x1 x2 rest ooo)
            (set! x2 (name-lin x1 x2 rest ooo)))))
       (define-!!s rest-group ...)))
    ((_ (name-mut name-lin 3) rest-group ...)
     (begin
       (define-syntax name-mut
         (syntax-rules ooo ()
           ((_ x1 x2 x3 rest ooo)
            (set! x3 (name-lin x1 x2 x3 rest ooo)))))
       (define-!!s rest-group ...)))
    ((_ (name-mut name-lin arg-no) rest-group ...)
     (syntax-error "third element must be 1-3." (name-mut name-lin arg-no)))
    ((_) #f)))

(define-!!s (reverse!!1 reverse! 1)
            (take!!1    take!    1)
            (map!!2     map!     2)
            (map!!3     map!     3))

;; test

(define list1 (list 1 2 3 4 5))
(define list2 (list 1 2 3 4 5))
(define list3 (list 1 2 3 4 5))
(define list4 (list 1 2 3 4 5))

(reverse!!1 list1)
(take!!1 list2 3)
(map!!2 + list3 (make-list 5 1))
(map!!3 + (make-list 5 1) list4)

(print list1)
(print list2)
(print list3)
(print list4)

hamayama(2018/11/09 12:10:12 UTC)(2018/11/11 08:35:16 UTC)