Skip to content

@kosh04 /gist:803647
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
[newLISP]比較関数の型チェックを少し厳しくする
;; newLISPの比較関数はどんな型でもお構いなく比較するので少々不便 (文字列と数値の比較なんて誰得)
;; ということで引数の型が異なる比較の場合はエラーを吐くようにしてみる
;; 利用方法
;; このファイルをユーザ初期化ファイル(~/init.lsp)に追加
;;; コマンドライン引数を指定してnewlispを起動する
;; % newlisp --strict
;; FIXME: 複合型(リストとラムダ・マクロ)を扱えない、nilと空リストを区別していない
(define COMPARE_TYPE_MASK 0x000F)
(define (type-of x)
(let ((types '("bool" "bool" "integer" "float" "string"
"symbol" "context" "primitive" "cdecl" "stdcall"
"quote" "list" "lambda" "macro" "array"
"dyn-symbol" ; ?
)))
(types (& COMPARE_TYPE_MASK ((dump x) 1)))))
(define (strict-compare)
(define compare-fn-symbols
'(= < > <= >= !=))
(define (type-match-all?)
(apply _= (map (lambda (x)
(nth (& 0x000F (nth 1 (dump x)))
;; o nil,true
;; o integer,float
;; ? list,array(,string)
;; ? primitive,cdecl
;; ? lambda,macro(,list)
;; ? symbol,dyn-symbol
'(0 0 1 1 2 3 4 5 6 7 8 9 10 11 12 13)))
$args)))
(dolist (cmp compare-fn-symbols)
;; 二重定義は避ける
(when (primitive? (eval cmp))
(letex (_cmp (sym (append "_" (term cmp))))
(constant '_cmp (eval cmp))
(constant cmp
(lambda ()
(if (apply type-match-all? $args)
(apply _cmp $args)
(throw-error
(string "mismatch type: "
(map (lambda (x)
(list (type-of x) x))
$args)))))))
))
true)
(if (find "--strict" $main-args)
(strict-compare))
;; EOF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.