Archive for the ‘scheme’ Category

Guile Scheme Macro Bug?

Wednesday, July 8th, 2009

syntax-rules是R5RS Scheme中规定的标准hygienic macro system,不过Guile Scheme中的实现似乎有点问题。

(define-syntax dotimes
  (syntax-rules ()
    ((_ n body ...)
     (let loop ((counter n))
       (if (> counter 0)
           (begin
             body ...
             (loop (- counter 1))))))))

上面定义了一个宏dotimes。理论上说,作为hyginic macro,外部环境对于宏里面的内部符号应该没有任何影响:

> (let ((loop 2)) (dotimes 4 (display loop)))
2222
> (let ((n 2)) (dotimes 4 (display n)))
2222
> (let ((counter 2)) (dotimes 4 (display counter)))
2222
> (let ((- ‘minus)) (dotimes 4 (display -)))
minusminusminusminus

MIT-scheme, Gambit以及PLT中都是上面的行为,唯独Guile过不了最后一关:

guile> (let ((- ‘minus)) (dotimes 4 (display -)))
minus<unnamed port>: In expression (- syntmp-counter-21 1):
<unnamed port>: Wrong type to apply: minus

明显的是,宏内部变量名都已被转换,比如counter变成了syntmp-counter-21,但’-'还是引用了外部let环境下的’-'。这该是个bug。

Sierpinski Triangle

Thursday, July 2nd, 2009

下面的图形被称为”Sierpinski Triangle”:
sierpinski triangle

生成它的代码很简单,比如用guile (需要guile-cairo):

(use-modules (cairo))

(define (polygon cr p1 p2 p3)
  (let ((x1 (car p1))
        (y1 (cdr p1))
        (x2 (car p2))
        (y2 (cdr p2))
        (x3 (car p3))
        (y3 (cdr p3)))
    (cairo-move-to cr x1 y1)
    (cairo-line-to cr x2 y2)
    (cairo-line-to cr x3 y3)
    (cairo-line-to cr x1 y1)))

(define (fill-tri cr x y size)
  (polygon cr (cons x y)
           (cons (+ x size) y)
           (cons x (- y size))))

(define min-size 8.0)

(define (sierpinski-tri cr x y size)
  (if (<= size min-size)
      (fill-tri cr x y size)
      (let ((new-size (/ size 2)))
        (sierpinski-tri cr x y new-size)
        (sierpinski-tri cr x (- y new-size) new-size)
        (sierpinski-tri cr (+ x new-size) y new-size))))

(define surf (cairo-svg-surface-create 300 300 "foo.svg"))
(define ctx (cairo-create surf))

(cairo-set-source-rgba ctx 1 0.2 0.2 0.6)
(cairo-set-line-width ctx 2.0)

(sierpinski-tri ctx 25 275 255)

(cairo-stroke ctx)
(cairo-surface-finish surf)

如上,结果会保存在文件foo.svg中。

A Tale of Two Cats

Monday, June 8th, 2009

每学一门语言首先想做的是用它写一个类UNIX下cat命令的东西,简单但至少涉及命令行处理和文件I/O。

Scheme版本:

(define (cat . arg)
  (let ((port (if (null? arg)
                  (current-input-port)
                  (car arg))))
    (let loop ((c (read-char port)))
      (if (not (eof-object? c))
          (begin
            (display c)
            (loop (read-char port)))))))

(define (main args)
  (if (null? (cdr args))
      (cat)
      (for-each (lambda (port) (cat port) (close-input-port port))
                (map open-input-file (cdr args)))))

Haskell版本:

import System.Environment

cat :: String -> IO ()
cat fn = do
  contents <- readFile fn
  putStr contents

main = do args <- getArgs
          if null args then interact id else mapM_ cat args

学了Haskell之后才知道Python里面的缩进、List Comprehension等似乎是从Haskell学来的。上面两个cat功能一样,区别是Haskell cat比较懒一点,那是因为Haskell是惰性求值的。勤快一点的版本只需要bytestring重新实现cat函数:

import qualified Data.ByteString.Lazy as B

cat :: String -> IO ()
cat fn = do
  bs <- B.readFile fn
  B.putStr bs

Write Yourself a Scheme - 1

Thursday, April 2nd, 2009

Here are the solutions to “Write Yourself a Scheme in 48 Hours”, “First steps: Compiling and running”.

ex1.
main = do args <- getArgs
    putStrLn (“Hello, “ ++ args !! 0 ++ “, “ ++ args !! 1)

ex2.
main = do line <- getLine
    putStrLn(“Hello, “ ++ line)

ex3.
str2int s = read s :: Int
str2flt s = read s :: Float

main = do args <- getArgs
    putStrLn (show (str2int(args !! 0) + str2int(args !! 1)))

cset-100

Wednesday, March 18th, 2009

今天向自己的hg仓库检入了第一百个changeset,初步完成了自己的第一个代码生成工具。回头在看看这五百行Scheme代码,我确信自己很不喜欢它们 — 直白但流于杂乱。

这几天读cgia才豁然发现,在聪明的程序员手中,很多枯燥的工作都能以优美的方式解决。问题是,很多时候,自己缺乏那种视角,所谓“不识庐山真面目,只缘身在此山中”。

如果让我重写,我可能会用ERB来解决之。Template System的好处是数据和逻辑分离,而我现在的Scheme代码中直接hard-code了目标代码。