Macro

2016-07-28
3分钟阅读时长
Scheme

Macro

symbol和syntax 及define和define-syntax 的区别

symbol和syntax具有类似的行为

symbol 

(define x 10)
'x
;; => 'x
(eval 'x)
;; => 10

syntax 

#'x
;; => #<syntax::3983 x>
(syntax-e #'x)
;; => 'x
#'(+ 1 2)
;; => #<syntax::4199 (+ 1 2)>
(syntax-e #'(+ 1 2))
;; => '(#<syntax::4564 +> #<syntax::4566 1> #<syntax::4568 2>)
(eval #'(+ 1 2))
;; => 3

define 

(define now (current-seconds))
now
(sleep 1)
now
;; =>
;; 1449308115
;; 1449308115

now被赋值为常数(在define时就已经确定)

define-syntax

也可在define-syntax时得到常数

`(+ 1 ,(+ 3 4)
;; => '(+ 1 7)
#`(+ 1 #,(+ 3 4))
;; => #<syntax::5345 (+ 1 7)>
(define-syntax now
  (lambda (stx)
    #`#,(current-seconds)))
;; =>
;; 1449308910
;; 1449308910

define-syntax会在得到结果的时候计算syntax

也就是说返回的值必须为syntax类型

(define-syntax now
  (lambda (stx)
    #'(current-seconds)))
now
(sleep 1)
now
;; =>
;; 1449308235
;; 1449308236

如果直接call函数会出现错误

(define-syntax now-err
  (lambda (stx)
    (current-seconds)))
now-err
(sleep 1)
now-err
;; =>
;; now-err: received value from syntax expander was not syntax
;;   received: 1449308517
;; now-err: received value from syntax expander was not syntax
;;   received: 1449308518

define-syntax的神奇组合

(lambda (stx) …)

stx为输入的所有内容

(define-syntax now
  (lambda (stx)
    (if (or (symbol? (syntax-e stx))
	    (> (length (syntax-e stx)) 1))
	(raise-syntax-error #f "<bad>" stx)
	#'(current-seconds))))

(now 1 2 3 4 5)
;; =>
;; stdin::17043: now: <bad>
;;   in: (now 1 2 3 4 5)
now
;; =>
;; stdin::17497: now: <bad>
;;  in: now
(now)
;; => 1449310256

以上代码规定为仅在(now)的时候current-seconds否则报错并输出stx

syntax-rules

Let的Lambda表达式转换

使用Let

(let ((x (+ 2 3)))
  (* x x))

Lambda语法糖

((lambda (x) (* x x)) (+ 2 3))

Let和Lambda转化

(define-syntax my-let
  (syntax-rules ()
    [(my-let ((x e)) body) ;; pattern
     ((lambda (x) body) e)] ;; body
    ))
;; More Arguments and Bodys
(define-syntax my-let
  (syntax-rules ()
    [(_ ((x e) ...) body body* ...) ;; pattern
     ((lambda (x ...) body body* ...) e ...)] ;; body
    ))

Macro展开

(expand-to-top-form '(my-let ((x (+ 2 3))) (* x x)))
;; => #<syntax ((lambda (x) (* x x)) (+ 2 3))>
Let*的Let转换

使用Let*

(let* ((x (+ 2 3))
       (y (* x x)))
  (+ x y))

Let语法糖

(let ((x (+ 2 3)))
  (let ((y (* x x)))
    (+ x y)))

Let*和Let转化

(define-syntax my-let*
  (syntax-rules ()
    [(_ () body body* ...)
     (my-let () body body* ...)]
    [(_ ((x e) (x* e*) ...) body body* ...)
     (my-let ((x e))
	     (my-let* ((x* e*) ...)
		      body body* ...))]))

Macro展开

(syntax->datum
 (expand-to-top-form
  '(my-let* ((x (+ 2 3))
	     (y (* x x)))
	    (+ x y))))
;; Output
;; '((lambda (x) (my-let* ((y (* x x))) (+ x y))) (+ 2 3))
And和Or的Macro转换

And

(define-syntax my-and
  (syntax-rules ()
    [(_) #t]
    [(_ e) e]
    [(_ e e* ...)
     (if e
	 (my-and e* ...)
	 #f)]))

Or

(define-syntax my-or
  (syntax-rules ()
    [(_) #f]
    [(_ e) e]
    [(_ e e* ...)
     (if e
	 e
	 (my-or e* ...))]))

存在Bugs

(my-or (display "hi\n") 5)
;; hi\nhi\n

可用Let消除Display时的返回值

(define-syntax my-or
  (syntax-rules ()
    [(_) #f]
    [(_ e) e]
    [(_ e e* ...)
     (let ((t e))
       (if t
	   t
	   (my-or e* ...)))]))

这里my-or的展开不会因为if的改变而改变

(my-let ([if (lambda (x y z) #f)])
  (my-or #f 4))

=> 4

syntax-rules参数

用于语法结构

(define-syntax my-if
  (syntax-rules (then else)
    [(my-if e1 then e2 else e3)
     (if e1 e2 e3)]))
;; (my-if <cond> then <expr> else <expr>)
;; (if <cond> <expr> <expr>)
define-syntax-rule

define-syntax 和 syntax-rules的神奇结合

生成随机数并define

(define-syntax-rule (define-random id)
  (define id (random)))
;; Test
(define-random RANDOM)
RANDOM
;; => 0.7080219810056901

生成多个随机数并define

(define-syntax-rule (define-random id ...)
  (begin
    (define id (random))
    ...))
;; Test
(define-random RANDOM1 RANDOM2)

syntax-parse

Where的Let转换 
(define-syntax-rule [where body-expr
			   [id val-expr]
			   ...]
  (let ([id val-expr]
	...)
    body-expr))
;; Test
(where
 (+ m n)
 [n 5]
 [m 7])

使用syntax-parse

(require (for-syntax syntax/parse))
(define-syntax where
  (lambda (stx)
    (syntax-parse
     stx
     [(where body-expr
	     [id val-expr]
	     ...)
      #'(let ([id val-expr]
	      ...)
	  body-expr)])))
;; Test
(where
 (+ m n)
 [8 5]
 [m 7])
;; let: bad syntax (not an identifier)
;;   at: 5
;;   in: (let ((5 8) (n 5)) (+ m n))

使在where层报错

(define-syntax where
  (lambda (stx)
    (syntax-parse stx
     [(where body-expr
	     [id val-expr])
      (unless (symbol? (syntax-e #'id))
	(raise-syntax-error #f "not an identifier" stx #'id))
      #'(let ([id val-expr])
	  body-expr)])))
;; Test
(where
 (+ m n)
 [5 8])
;; where: not an identifier
;;   at: 5
;;   in: (where (+ m n) (5 8))

let-syntax

无副作用的syntax

(let-syntax ([m (syntax-rules ()
		  [(m !) 10]
		  [(m) 9])])
  (m !))
;; => 10

技巧向 

(+ 1 2 3)

可以把 + 放在任意位置

(1 2 . + . 3)

List下有同样的效果

'(1 2 3 4 5 . 9 . 10)
;; '(9 1 2 3 4 5 10)

待续。。。。

#Scheme
上一页 Lambda表达式
下一页 不动点组合子

相关

CPS变换
Lambda表达式
不动点组合子
技巧向