next up previous
Next: 1.4 コードの表示 Up: 1 Schemeのコンパイラ Previous: 1.2 コンパイラの呼び方

1.3 コンパイラの初期化

変数に値を代入するマクロであるdefineは scheme-interp で用いていたマクロと同じではなく, 新しく定義します.

(defun init-scheme-compiler ()
  (init-scheme-macros)
  )

(defun init-scheme-macros nil
  (def-scheme-macro and (&rest args)
    (cond ((null args) 'T)
          ((null (cdr args)) (car args))
          (t `(if ,(car args)
                  (and ,@(cdr args))))))
  
  (def-scheme-macro let (bindings &rest body)
    `((lambda ,(mapcar #'car bindings) ,@body)
      ,@(mapcar #'cadr bindings)))
  
  (def-scheme-macro let* (bindings &rest body)
    (if (null bindings)
        `(begin ,@body)
      `(let (,(car bindings))
         (let* ,(cdr bindings) ,@body))))
  
  (def-scheme-macro or (&rest args)
    (cond
     ((null args) 'nil)
     ((null (cdr args)) (car args))
     (t (let ((var (gensym)))
          `(let ((,var ,(car args)))
             (if ,var ,var (or ,@(cdr args))))))))
  
  (def-scheme-macro cond (&rest clauses)
    (cond
     ((null clauses) nil)
     ((null (cdr clauses))
      `(or ,(car clauses) (cond ,@(cdr clauses))))
     ((eq (car (car clauses)) 'else)
      `(begin ,@(cdr (car clauses))))
     (t `(if ,(car (car clauses))
             (begin ,@(cdr (car clauses)))
           (cond ,@(cdr clauses))))))
  
  (def-scheme-macro case (key &rest clauses)
    (let ((key-val (gensym "KEY")))
      `(let ((,key-val ,key))
         (cond
          ,@(mapcar
             #'(lambda (clause)
                 (if (eq (car clause) 'else)
                     clause
                   `((member ,key-val ',(car clause))
                     ,@(cdr clause))))
             clauses)))))
  
  (def-scheme-macro letrec (bindings &rest body)
    `(let
         ,(mapcar #'(lambda (v) (list (car v) nil))
           bindings)
       ,@(mapcar #'(lambda (v) `(set! ,@v)) bindings)
       ,@body))
  
  (def-scheme-macro delay (computation)
    `(lambda () ,computation))

  (def-scheme-macro define (name &rest body)
    (if (atom name)
        `(begin (set! ,name  ,@body) ',name)
      `(define ,(car name) 
           (lambda ,(cdr name) ,@body))))

  (def-scheme-macro define (name &rest body)
    (if (atom name)
        `(name! (set! ,name . ,body) ',name)
      (scheme-macro-expand
       `(define ,(car name) 
            (lambda ,(cdr name) . ,body)))))
  )

(defmacro def-scheme-macro (name parmlist &rest body)
  `(setf (get ',name 'scheme-macro)
         #'(lambda ,parmlist ,@body)))
式のコンパイルは,その式を本体とした引数変数が無い lambdaフォームをコンパイルするという形で行います.

<cl> (scheme-compile '(begin "doc" (write x) y))

#S(FN :CODE
      ((ARGS 0) (CONST "doc")
       (POP) (GVAR X)
       (GVAR WRITE) (CALL 1)
       (POP) (GVAR Y) (RETURN))
      :ENV NIL :NAME NIL :ARGS NIL)
というように,コンパイラは 名前nameフィールドにnilの入ったfn構造体を返します. defineはこの名前フィールドに名前をいれます.

generated through LaTeX2HTML. M.Inaba 平成18年5月6日