syntax-rules: define-syntax-rule, define-syntax-rules

こんなのもありかなー、とか。

	;; define-syntax-rule
	(define-syntax define-syntax-rule
	(syntax-rules ()
	((_ (name (literal ...) arg ...)(body ...))
	(define-syntax name
	(syntax-rules (literal ...)
	((_ arg ...)
	(body ...)))))
	((_ (name arg ...)(body ...))
	(define-syntax-rule (name () arg ...)(body ...)))))
	(define a '(1 2 3))
	a
	; -> (1 2 3)
	(define-syntax-rule (null! x)
	(set! x '()))
	(null! a)
	; -> ()
	a
	; -> ()
	(macroexpand '(define-syntax-rule (null! x)
	(set! x '())))
	;; (#<identifier user#define-syntax> null!
	;; (#<identifier user#syntax-rules> ()
	;; ((#<identifier user#_> x)
	;; (set! x '()))))
	(define-syntax-rule (lets (<- in) var <- init in body ...)
	(let ((var init))
	body ...))
	(lets i <- 10
	in (print i)(print (* i i)))
	;; 10
	;; 100
	;; #<undef>
	(macroexpand '(define-syntax-rule (lets (<- in) var <- init in body ...)
	(let ((var init))
	body ...)))
	;; (#<identifier user#define-syntax> lets
	;; (#<identifier user#syntax-rules> (<- in)
	;; ((#<identifier user#_> var <- init in body |...|)
	;; (let ((var init)) body |...|))))

view raw define-syntax-rule.scm hosted with ❤ by GitHub

こんなのもありかなーとか。

	(define-syntax define-syntax-rules
	(syntax-rules ()
	((_ (name literal ...)
	((arg1 ...) body1 ...)
	((arg2 ...) body2 ...) ...)
	(define-syntax name
	(syntax-rules (literal ...)
	((_ arg1 ...) body1 ...)
	((_ arg2 ...) body2 ...) ...)))))
	(define-syntax-rules (implications =>)
	(((pred => body ...) ...)
	(begin
	(when pred
	body ...) ...)))
	(let ((x 0)(y 0)(hoge "hello")(false #f))
	(implications ((zero? x) => (display x)(newline))
	((number? y) => (format #t "~a is number." y))
	(false => (print hoge))
	(#t => (print "world !"))))
	;; 0
	;; 0 is number.world !
	;; #<undef>
	(define-syntax-rules (hoge)
	(()
	(display "hoge"))
	((arg1)
	(format #t "hoge - ~a" arg1))
	((arg1 arg2)
	(format #t "hoge - ~a - ~a" arg1 arg2))
	((arg1 arg2 arg3)
	(format #t "hoge - ~a - ~a - ~a" arg1 arg2 arg3))
	((arg1 arg2 arg3 arg4)
	(format #t "hoge - ~a - ~a - ~a - ~a" arg1 arg2 arg3 arg4)))
	(hoge in 1)
	; -> hoge - 1#<undef>
	(hoge 1 2)
	; -> hoge - 1 - 2#<undef>
	(hoge 1 2 3)
	; -> hoge - 1 - 2 - 3#<undef>
	(hoge 1 2 3 4)
	; -> hoge - 1 - 2 - 3 - 4#<undef>

view raw define-syntax-rules.scm hosted with ❤ by GitHub

define-syntax-rules がそうなら、define-syntax-rule もこうかなーとか。

	(define-syntax define-syntax-rule
	(syntax-rules ()
	((_ (name literal ...)((arg ...) body ...))
	(define-syntax name
	(syntax-rules (literal ...)
	((_ arg ...)
	body ...))))))
	(define a '(1 2 3))
	a
	; -> (1 2 3)
	(define-syntax-rule (null!)
	((x)(set! x '())))
	(null! a)
	; -> ()
	a
	; -> ()
	(macroexpand '(define-syntax-rule (null!)
	((x)(set! x '()))))
	;; (#<identifier user#define-syntax> null!
	;; (#<identifier user#syntax-rules> ()
	;; ((#<identifier user#_> x)
	;; (set! x '()))))
	(define-syntax-rule (lets <- in)
	((var <- init in body ...)
	(let ((var init))
	body ...)))
	(lets i <- 10
	in (print i)(print (* i i)))
	;; 10
	;; 100
	;; #<undef>
	(macroexpand '(define-syntax-rule (lets <- in)
	((var <- init in body ...)
	(let ((var init))
	body ...))))
	;; (#<identifier user#define-syntax> lets
	;; (#<identifier user#syntax-rules> (<- in)
	;; ((#<identifier user#_> var <- init in body |...|)
	;; (let ((var init)) body |...|))))

view raw define-syntax-rule-2.scm hosted with ❤ by GitHub

結局このくらいが丁度良いのかも。

	(define-syntax define-syntax-rule
	(syntax-rules ()
	((_ (name arg ...) body ...)
	(define-syntax name
	(syntax-rules ()
	((_ arg ...)
	body ...))))))

view raw define-syntax-rule-3.scm hosted with ❤ by GitHub