#:g1: VAXFlavorsの紹介

Posted 2014-08-31 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の244日目です。

VAXFlavorsとはなにか

 VAXFlavorsは、VAX LISPに付属していたFlavorsの実装です。当時DECのDave Wickert氏がメインで開発していた様子。

パッケージ情報

パッケージ名VAXFlavors
Quicklisp×

インストール方法

 旧DECのVMSでは一定の期間が経過したソフトウェアはVMS Retired Softwareという扱いになり、愛好家が趣味で利用/配布する分には問題ないものとなるようです。
VAX LISP 3.1も配布している人がいるのですが、この中にVAXFlavorsが含まれていますのでダウンロードします。

unzipするとVMSのテープイメージのファイルなのでここから更にファイルを取り出します。有り難いことにvmsbackupというツールがあるので、これを利用します。

$ vmsbackup -x -b 9216 -f lisp031.a

以下、b..c..dと続く

 これでファイルが取り出せますが、残念ながらflvtrace.lspvfが破損している様子。
たまたまVMSの実機上にVAX LISPをインストールしているサイトがあったので破損箇所を確認することができましたが、こんな感じです。

;;;
;;; -------------------------------------------------------------------------
;;;
;;; User accessed macro/function calls.
;;;

;;; Trace a method. (defmacro trace-method (&rest val) "TRACE-METHOD (flavor-name1 [type] :message1) (flavor-name2 [type] :message2) ...

where type is :AFTER :PRIMARY :BEFORE :AND :OR :OVERRIDE :WHOPPER :DEFAULT or :CASE (defaults to :PRIMARY)

This macro will set the requested method as being traced. TRACE-METHOD with no arguments will list the current methods being traced."

`(flavors-trace-common t ',val))

;;; Untrace a method. (defmacro untrace-method (&rest val) "UNTRACE-METHOD (flavor-name1 [type] :message1) (flavor-name2 [type] :message2) ...

where type is :AFTER :PRIMARY :BEFORE :AND :OR :OVERRIDE :WHOPPER :DEFAULT or :CASE (defaults to :PRIMARY)

This macro will clear the requested method from being traced. UNTRACE-METHOD with no arguments clear all methods currently being traced."

`(flavors-trace-common nil ',val))

;;; Trace a flavor. (defun trace-flavor (&rest flavor-list) "TRACE-FLAVOR flavor1 flavor2 ...

This function enables tracing of all methods on the indicated flavors."

(dolist (flavor-name flavor-list) (let ((flavor-obj (flavors-validate-flavor-name flavor-name))) (setf (flavor-trace-marker flavor-obj) *flavor-trace-marker*))))

;;; Untrace a flavor. (defun untrace-flavor (&rest flavor-list) "UNTRACE-FLAVOR flavor1 flavor2 ...

This function disables tracing for the flavors. Methods being traced via TRACE-METHOD will still be traced."

(dolist (flavor-name flavor-list) (let ((flavor-obj (flavors-validate-flavor-name flavor-name))) (setf (flavor-trace-marker flavor-obj) nil))))

;;; Trace all flavors. (defun trace-all-flavors () "TRACE-ALL-FLAVORS

Enables tracing for all flavors. To disable, use UNTRACE-METHODS."

(setf *flavor-trace-marker* t))

;;; *EOF*

末尾にvfが付いているのがVAXFlavors関係のファイルなので適当に動くように修正します。

試してみる

 今回もお馴染のBankAccountです。

(defpackage :vaxflavors.demo
  (:use :cl :vaxflavors)
  (:shadowing-import-from :vaxflavors
                          :defmethod :make-instance :method
                          :make-method))

(cl:in-package :vaxflavors.demo)

;;; 再定義でCERRORを出す => T / 出さない => NIL (defparameter *error-out* nil)

(defflavor bank-account ((dollars 0)) () :initable-instance-variables :gettable-instance-variables :settable-instance-variables)

(defmethod (bank-account :deposit) (x) (send self :set-dollars (+ (send self :dollars) x)))

(defmethod (bank-account :withdraw) (x) (send self :set-dollars (max 0 (- (send self :dollars) x))))

(defparameter *my-account* (make-instance 'bank-account :dollars 200))

(send *my-account* :dollars) ;=> 200 (send *my-account* :deposit 50) ;=> 250 (send *my-account* :withdraw 100) ;=> 150 (send *my-account* :withdraw 200) ;=> 0

(defflavor stock-account ((num-shares 0) (price-per-share 30)) (bank-account) :initable-instance-variables :gettable-instance-variables :settable-instance-variables)

(defmethod (stock-account :set-dollars) (x) (setq num-shares (/ x price-per-share)) (send self :dollars))

(defmethod (stock-account :dollars) () (* num-shares price-per-share))

(defparameter *my-stock* (make-instance 'stock-account :num-shares 10))

(send *my-stock* :dollars) ;=> 300

(send *my-stock* :set-dollars 600) ;=> 600

(send *my-stock* :deposit 60) ;=> 660

(send *my-stock* :num-shares) ;=> 22

(send *my-stock* :withdraw 120) ;=> 540

(send *my-stock* :num-shares) ;=> 18

 デフォルトだとフレイバーとメソッドの再定義はCERRORが出るようになっていますが、*ERROR-OUT*をNILにすることで抑制可能です。

まとめ

 今回は、VAXFlavorsを紹介してみました。
VAXFlavorsは当時の評判によるとMITのオリジナルのFlavorsとの互換性が高かったようです。
それはさておき2、30年前のCommon Lispのソースをコンパイルしてみていつも思うのは、当時のコンパイラの構文チェックや型チェックはゆるかったんだなということですね。

comments powered by Disqus