-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtao-h.lisp
131 lines (105 loc) · 3.45 KB
/
tao-h.lisp
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
(tao:common-lisp)
(in-package #:tao-internal)
(define
"hash"
(subr nil)
:documentation
"形式 : hash object
object がシンボルかストリングなら、そのハッシュ値を返し、そうでなければ
エラーを返す。"
:example
"(hash 'a) -> 97
(hash 'b) -> 98")
(define
"hash-table-count"
#'hash-table-count
:documentation
"形式 : hash-table-count table
ハッシュ表 table のエントリの個数を返す。
ハッシュ表が生成された直後、及び clrhash 関数でクリアされた直後の
エントリ数は 0 。"
:example
"(!a (make-hash-table)) -> {vector}81749(hash-table . 8)
(hash-table-count a)) -> 0
(!(gethash 'color a) 'red) -> red
(hash-table-count a) -> 1")
(define
"hash-table-p"
#'cl:hash-table-p
:documentation
"形式 : hash-table-p object
object がハッシュ表なら t 、それ以外の場合は nil を返す。"
:example
"(!a (make-hash-table)) -> {vector}81749(hash-table . 8)
(hash-table-p a) -> t
(hash-table-p b) -> エラー")
(defmacro tao::*Hclauses (&body body)
(tao.logic::make-anonymous-predicate-expr
(length (elt (elt body 0) 1))
body))
(define
"Hclauses"
(macro (&body body)
`(tao.logic::compile-anonymous-predicate
,(length (elt (elt body 0) 1))
',body))
:documentation
"形式 : hclauses (&+ A1' [(&aux var ...)] B11 ... B1n1) ...
(&+ Am' [(&aux var ...)] Bm1 ... Bmnm)
名前なしの C-resolver を作る。
シンボル A1' とシンボル A1 の違いについては、関数 &+ を参照。"
:example
"(&(&aux _a) ((hclauses (&+ (_x _y 3) (list _x _y))
(&+ (_x _y _x) (list _x _y)))
1 (_a 2) _a ))
最初に、第 1 U-resolver (&+ (_x _y 3) (list _x _y) を選び、
a を 3 にしてリスト (1 (3 2)) を返す。
バックトラックが起これば、
第 2 U-resolver (&+ (_x _y)) (list _x _y))
を選び x を 1 にして (1 (1 2)) を返す。
もう一度、バックトラックが起こればフォーム & は nil を返す。
つまり選択は、完全に失敗となる。")
(define
"hidar"
(macro (var)
`(and ,var
(if (boundp ',var)
(if (eq (symbol-value ',var) ,var)
(cons ',var (symbol-value ',var))
(cons ',var ,var))
(cons ',var ,var))))
:documentation
"形式 : hidar var
var の束縛を返す。その束縛は変数名とその値のペアによって表される。
var は値をもつ変数でなくてはならない。"
:example
"(!x 12) -> 12
(hidar x) -> (12 . {vector}1830428(package . 12))
(prog (a) (!a 123) (hidar a)) -> (123 . a)")
(define
"host-fullname"
(subr ()
(long-site-name))
:documentation
"使っているホストコンピュータの full-namestring を格納。"
:example
"host-fullname -> \"Titanium\"")
(define-symbol-macro host-fullname (tao:host-fullname))
(define
"host-name"
(subr ()
(short-site-name))
:documentation
"使っているホストコンピュータのニックネームを namestring で格納。"
:example
"host-name -> \"Ti\"")
(define-symbol-macro host-name (tao:short-site-name))
(define
"host-namestring"
#'host-namestring
:documentation
"形式 : host-namestring pathname
ファイル pathname のホスト名を文字列表現で返す。"
:example
"(host-namestring \"Ti::bs*<anata>konata.sonata.5\") -> \"Ti::\"")
;;; *EOF*