愉♂悅的scheme之旅（6）-用宏構建DSL

寫完這篇文章之後，我需要休息一段時間，太累了。叫上基友：@大笨蛋千里冰封，@霧雨魔理沙，@Glavo。

尚未解決的問題

在上一篇文章的結尾，我們還殘留了一個問題，那麼究竟在什麼情況下pmatch會出現不正確的結果呢？

(define-syntax ppatn (syntax-rules (cons else const )n [(_ fctx val (const cs) res) (if (equal? cs val)n resn fctx)]n [(_ fctx val else res) res]n [(_ fctx val (cons a b) res) (if (pair? val)n (ppat fctx (car val) an (ppat fctx (cdr val) b res))n fctx)]n [(_ fctx val var res) (let ((var val))n res)]))nn(define-syntax pmatchn (syntax-rules ()n [(_ val) (error "Pattern Matching Error")]n [(_ val (pattern res) rest ...)n (let ((t val))n (ppat (pmatch t rest ...)n t pattern res))]))nn(let ([t 2])n (pmatch (1 2 3)n [(cons t (cons x (const 1))) t]n [(cons x y) t]))n

我們期望返回2，卻返回了1，是因為第一次匹配雖然失敗了，但是已經把t shadow掉了，我們必須保證兩條匹配之間不發生任何關係。

這樣就很簡單了，我們要把fctx修改成一個閉包，而不是表達式。

(define-syntax ppatn (syntax-rules (cons else const )n [(_ fctx val (const cs) res) (if (equal? cs val)n resn (fctx))]n [(_ fctx val else res) res]n [(_ fctx val (cons a b) res) (if (pair? val)n (ppat fctx (car val) an (ppat fctx (cdr val) b res))n (fctx))]n [(_ fctx val var res) (let ((var val))n res)]))nn(define-syntax pmatchn (syntax-rules ()n [(_ val) (error "Pattern Matching Error")]n [(_ val (pattern res) rest ...)n (let* ((t val)(closure (lambda () (pmatch t rest ...))))n (ppat closuren t pattern res))]))nn(let ([t 2])n (pmatch (1 2 3)n [(cons t (cons x (const 1))) t]n [(cons x y) t]))n

用syntax-case 構建DSL

syntax-rules因為沒有辦法寫非衛生宏，所以我們很多情況下都不會去用他，相比之下，syntax-case更好用，舉個例子。

(define-syntax blockn (syntax-rules ()n [(_ exps ...) (call/cc (lambda (e)n (let ((break (lambda () (e (void)))))n exps ...)))]))n(block (break)n 1)n

我們提示的錯誤是沒有定義break這個變數，為什麼呢，我們來手動展開這個表達式試試看。

(<block,block,{}> (<break,break,{}>) 1)nn(<call/cc,call/cc,{}> (<lambda,lambda,{}> (<e,e,{}>)n (<let,let,{}> ((<break,break,{}> (<lambda,lambda,{}> () (<e,e,{}> (<void,void,{}>)))))n (<break,break,{m1}>) 1)))nn(<call/cc,call/cc,{m1}> (<lambda,lambda,{m1}> (<e,e,{m1}>)n (<let,let,{m1}> ((<break,break,{m1}> (<lambda,lambda,{m1}> () (<e,e,{m1}> (<void,void,{m1}>)))))n (<break,break,{}>) 1)))nn(call/cc (<lambda,lambda,{m1}> (<e,e,{m1}>)n (<let,let,{m1}> ((<break,break,{m1}> (<lambda,lambda,{m1}> () (<e,e,{m1}> (<void,void,{m1}>)))))n (<break,break,{}>) 1)))nn(call/cc (lambda (g1)n (<let,let,{m1}> ((<break,break,{m1}> (<lambda,lambda,{m1}> () (g1 (<void,void,{m1}>)))))n (<break,break,{}>) 1)))nn(call/cc (lambda (g1)n (let ((g2 (lambda () (g1 (void)))))n (<break,break,{}>) 1)))nn(call/cc (lambda (g1)n (let ((g2 (lambda () (g1 (void)))))n (break) 1)))n

展開之後發現一個break有m1，而一個沒有，導致聯繫不上，我們必須使marks保持一致。

(datum->syntax #id break) 這樣我們就把id的marks塞進break裡面。

(datum->syntax #id break) => <break,break,{m1,m2,...}>。

(define-syntax blockn (lambda (stx)n (syntax-case stx ()n [(k exps ...) #`(call/cc (lambda (e)n (let ((#,(datum->syntax #kn break) (lambda () (e (void)))))n exps ...)))])))nn(block n (break)n 1)n

現在可以工作了。

syntax-parameterize

但是我依然不推薦這樣寫，因為這樣一旦宏寫得比較長，就會很亂，而且會導致一些莫名其妙的錯誤，因此，syntax-parameterize是一個極好的解決方案。

(require racket/stxparam)n(define-syntax-parameter break (syntax-rules ()))n(define-syntax blockn (syntax-rules ()n [(_ exps ...) (call/cc (lambda (e)n (syntax-parameterizen ([break (syntax-rules ()n [(_) (e (void))])])n exps ...)))]))nn(block (break)n 1)n

看起來清爽多了喵。

alternative way

但是，有一些scheme實現，既不支持syntax-parameterize，又不支持syntax-case，就比較尷尬了，但是還是有解決辦法的。

(define break (lambda () (error "out of the block")))n(define-syntax blockn (syntax-rules ()n [(_ exps ...) (call/cc (lambda (e)n (let ((obreak break))n (set! break (lambda ()n (set! break obreak)n (e (void)))))n exps ...))]))n(block (break) 1 )n

這種構建dsl的辦法其實我在前面已經用過很多次了，只看你有沒有理解，注意結束時要break恢復成原來的,或者直接上dynamic-wind或者parameterize。

最後

迄今為止的六篇文章：愉悅的scheme之旅（1）--動態作用域

愉悅的scheme之旅（2）--用callcc合成控制流

愉悅的scheme之旅（3）-scheme衛生宏系統的實現

愉悅的scheme之旅(4)--Delimited Continuations

某愉悅的scheme之旅（5）--從零開始實現模式匹配宏

祝大家愚人節快樂。