LOLのdefmacro!gをGaucheで

30分プログラム、その607。id:athosに影響されて、Let Over LambdaのマクロをGaucheで書いてみる。

今回書くのはdefmacro!gというマクロ。これは、g!で始まるシンボルを自動でgensymにしてくれる。使い方は下に書いてあるのを見てください。
で、このdefmacro!gはコード全体を走査して、g!で始まるシンボルを取り出してくる。これが、flattenでリストを潰してfilterするだけで簡単に書けちゃう。こういうのが、全部の構文要素がリストでできてるLispの強みだと思う。

使い方

;; nifは第1引数が正、ゼロ、負で場合分けするマクロ
;;    (nif 42 'plus 'zero 'minus) => 'plus
;;
;; g!resultが自動でgensymになる
(define-macro!g (nif a plus zero neg)
  `(let1 ,g!result ,a
	 (cond
	  ((< 0 ,g!result) ,plus)
	  ((= 0 ,g!result) ,zero)
	  ((> 0 ,g!result) ,neg))))

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-
;;
;; defmacro.scm -
;;
;; Copyright(C) 2009 by mzp
;; Author: MIZUNO Hiroki / mzpppp at gmail dot com
;; http://howdyworld.org
;;
;; Timestamp: 2009/06/21 21:37:24
;;
;; This program is free software; you can redistribute it and/or
;; modify it under MIT Lincence.
;;

(use srfi-1)

(define (flatten xs)
  (if (pair? xs)
      (append-map flatten xs)
      (list xs)))

(define (g!symbol? name)
  (and (symbol? name)
       (> (string-length (symbol->string name)) 2)
       (string=? "g!" (substring (symbol->string name) 0 2))))

(define-macro (define-macro!g name . body)
  (let1 gensyms
	(delete-duplicates (filter g!symbol? (flatten body)))
	`(define-macro ,name
	   (let ,(map (lambda (sym) `(,sym (gensym))) gensyms)
	     ,@body))))

;; usage:
(define-macro!g (nif a plus zero neg)
  `(let1 ,g!result ,a
	 (cond
	  ((< 0 ,g!result) ,plus)
	  ((= 0 ,g!result) ,zero)
	  ((> 0 ,g!result) ,neg))))

(nif -11 'plus 'zero 'minus)

参考

• 過去の30分プログラム
• Let Over Lambda