public
Created

[newLISP]比較関数の型チェックを少し厳しくする

  • Download Gist
gistfile1.sls
Scheme
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
;; 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.