* Menu
[[About:self:AboutPage.txt]] | [[Profile:http://iddy.jp/profile/southly/]] | [[まとめ:self:1163859357.txt]] | [[オリジナル:http://ninjinix.x0.com/rn/]] | [[xyzzy:http://raido.sakura.ne.jp/southly/xyzzy/site-lisp/]] | [[あんてな:http://i-know.jp/southly/listall]] | [[■:http://raido.sakura.ne.jp/southly/lisp/ni/view.lisp]] | [[buzz:http://www.google.com/profiles/southly#buzz]]
page 0 - << : 0 : 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 : >>
* 2006-03-28
「0(ゼロ)」にスラッシュが入ったフォントがいっぱい見つかってうれしくなったので、色設定を見直し。
暗い背景にしてみた。
xyzzy.png
[[(ReadMore...) index.rb?1143555179.txt]]
暗い背景にしてみた。
xyzzy.png
[[(ReadMore...) index.rb?1143555179.txt]]
* 2007-02-21
擬似乱数生成器 Xorshift RNGs ってのを見つけた。
http://lucille.atso-net.jp/blog/?p=9
書いてみる
http://lucille.atso-net.jp/blog/?p=9
書いてみる
(let ((x 123456789) (y 362436069) (z 521288629) (w 88675123))
(defun xor128 ()
(let ((a (logxor x (logand #xFFFFFFFF (ash x 11)))))
(shiftf x y z w)
(setq w (logxor (logxor w (ash w -19)) (logxor a (ash a -8)))))))
(dotimes (i 100)
(format t "~8,'0x~%" (xor128)))
* Menu
[[About:self:AboutPage.txt]] | [[Profile:file/southly/]] | [[まとめ:self:1163859357.txt]] | [[オリジナル:http://ninjinix.x0.com/rn/]] | [[xyzzy:lisp/]] | [[あんてな:listall]] | [[■:lisp]] | [[buzz:files/southly#buzz]]
* 2010-02-28 :
- debian squeeze でsbclインストール後のコア作成に失敗していた。
- 以下がエラーメッセージ。
; #<PACKAGE "ASDF1">
; registering #<SYSTEM SB-GROVEL {B4F1921}> as SB-GROVEL
;
; compilation unit aborted
; caught 1 fatal ERROR condition
Error running init-common-lisp-controller-v4: Lock on package SB-IMPL violated
when interning NATIVE-FILE-KIND.
See also:
The SBCL Manual, Node "Package Locks"
- 以下のように修正して解決した。
--- /usr/share/common-lisp/source/common-lisp-controller/post-sysdef-install.lisp~ 2010-02-28 17:58:19.000000000 +0900
+++ /usr/share/common-lisp/source/common-lisp-controller/post-sysdef-install.lisp 2010-02-28 18:01:36.000000000 +0900
@@ -61,7 +61,7 @@
#+sbcl
(defun get-owner-and-mode (directory)
(when (eq :directory
- (sb-impl::native-file-kind (namestring directory)))
+ (sb-unix::unix-file-kind (namestring directory)))
;; check who owns it
(multiple-value-bind (res dev ino mode nlink uid gid rdev size atime mtime)
(sb-unix:unix-stat (namestring directory))
で、以下を実行。$ sudo dpkg-reconfigure common-lisp-controller
* 2010-01-20
- Scheme コードバトン (CL fork)
- やったことは以下の通り。
- untabify
- format指示子を大文字に揃える
- インデントを調整
- 辞書が存在しない時の動作を修正
- package-nameがprintされないようにして、オリジナルの辞書と似た感じの出力を目指した
- asdfのパッケージ化
- lispの関数は10行越えると、理解が大変になってくる。修行が足りないなぁ
- xyzzy lispでforkしようかと思っていたけれど、ABCLの動作と似た感じになるだろうから、微妙。
diff --git a/package.lisp b/package.lisp
new file mode 100644
index 0000000..3667c7a
--- /dev/null
+++ b/package.lisp
@@ -0,0 +1,13 @@
+;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
+
+;;; Package Management
+(in-package :cl-user)
+
+(defpackage :hige
+ (:use :cl)
+ #+ABCL (:shadow :y-or-n-p)
+ (:export #:pin
+ #:pon
+ #:pun
+ #:pan
+ #:pen))
diff --git a/scheme_baton.asd b/scheme_baton.asd
new file mode 100644
index 0000000..b2d9ce6
--- /dev/null
+++ b/scheme_baton.asd
@@ -0,0 +1,4 @@
+(defsystem :scheme_baton
+ :serial t
+ :components ((:file "package") (:file "scheme_baton"))
+ )
diff --git a/scheme_baton.lisp b/scheme_baton.lisp
index 27713dc..fc50ad7 100644
--- a/scheme_baton.lisp
+++ b/scheme_baton.lisp
@@ -53,6 +53,7 @@
;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり．
;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。
;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。
+;; 11. NANRI (http://raido.sakura.ne.jp/southly/rn/): デバッグとちょっとした整理。あと (asdf:oos 'asdf:load-op :scheme_baton) でロードできるようにした。
;;
;; =================================================================================================================================================
;; これより下がコードとその説明 - 変更・削除歓迎
@@ -79,18 +80,6 @@
;; ■辞書ファイルの例
;; http://gist.github.com/273424
-;;; Package Management
-(in-package :cl-user)
-
-(defpackage :hige
- (:use :cl)
- #+ABCL (:shadow :y-or-n-p)
- (:export #:pin
- #:pon
- #:pun
- #:pan
- #:pen))
-
(in-package :hige)
;;quek-san's http://read-eval-print.blogspot.com/2009/04/abcl-java.html without cl-ppcre
@@ -177,25 +166,25 @@
(format *debug-io* "done~%"))
*dict*))
-(defmacro with-entries ((entry) &rest body)
+(defmacro do-entries ((entry) &rest body)
`(dolist (,entry (entries-of *dict*))
,@body))
;;; Top-Level Functions
(defun pin ()
"Register new entries to the dictionary."
- (unless *dict-file*
- (ensure-directories-exist *dict-file*))
(with-dict ()
- (loop (add-entry (prompt-for-entry))
- (if (not (y-or-n-p "Another words to register? [yn]: ")) (return)))))
+ (loop
+ (add-entry (prompt-for-entry))
+ (unless (y-or-n-p "Another words to register? [yn]: ")
+ (return)))))
(defun pon ()
"Start self-study english vocabulary quiz."
(with-dict ()
- (with-entries (e)
+ (do-entries (e)
(p "~&~A (score: ~D): " (read-aloud (entry-word e)) (entry-score e))
- (ready?)
+ #-ABCL (ready?)
#-ABCL (p "~&~A [Ynq]: " (entry-meaning e))
:again
(case (query #+ABCL (entry-meaning e))
@@ -209,12 +198,12 @@
(defun pan ()
"Search the word user has input from the dictionary"
(with-dict (:read-only t)
- (let ((word (intern (prompt-read "Word to search") :hige)))
+ (let ((word (intern (prompt-read "Word to search") #.*package*)))
(format t "~A" (or (search-dict word) "Not found.")))))
(defun pun (&key score-threshold)
- (if (and score-threshold
- (not (numberp score-threshold)))
+ (when (and score-threshold
+ (not (numberp score-threshold)))
(error "pun: score-threshold must be number."))
(setup-dict)
(dump-dict :score-threshold score-threshold))
@@ -226,7 +215,7 @@
(with-dict ()
(when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック
(error "Dictionary size is too small .~%"))
- (with-entries (e)
+ (do-entries (e)
(p "~&~A (score: ~D): "
(if meaning? (entry-meaning e) (read-aloud (entry-word e)))
(entry-score e))
@@ -239,13 +228,15 @@
:do (p "~A.~A " i (if meaning? (entry-word item) (entry-meaning item))))
(p " [1-~Aq]: " n-choice)
(nlet itr ((query (read *query-io* nil nil)))
- (cond ((and (numberp query) (> query 0) (> (1+ n-choice) query))
+ (cond ((and (numberp query) (< 0 query (1+ n-choice)))
(if (= query correct-answer)
(incf (entry-ok-count e))
(incf (entry-ng-count e))))
- ((and (symbolp query) (string= (symbol-name query) "Q")) (return))
- (t (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ")
- (itr (read *query-io* nil nil)))))))))
+ ((and (symbolp query) (string= (symbol-name query) "Q"))
+ (return))
+ (t
+ (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ")
+ (itr (read *query-io* nil nil)))))))))
;;; Auxiliary Functions
(defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*))
@@ -261,36 +252,51 @@
(mapcar #'(lambda (e)
(make-entry :word (entry-word e)
:meaning (entry-meaning e)
- :ok-count (or (entry-ok-count e) 0)
- :ng-count (or (entry-ng-count e) 0)))
+ :ok-count (or (ignore-errors (entry-ok-count e)) 0)
+ :ng-count (or (ignore-errors (entry-ng-count e)) 0)))
entries))
+(defmacro with-dictionary-io-syntax (&body body)
+ `(with-standard-io-syntax
+ (let ((*readtable* (copy-readtable nil))
+ (*package* #.*package*) ; 単語Symbolのホームは:higeパッケージです。
+ (*read-eval* nil))
+ (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。
+ ,@body)))
+
(defun read-dict (file)
"Read dictionary data from a file."
- (let ((*readtable* (copy-readtable nil))
- (*package* #.*package*)) ; 単語Symbolのホームは:higeパッケージです。
- (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。
- (with-open-file (in file)
- (normalize-dict
- (loop :for word := (read in nil in) :until (eq word in)
- :collect word)))))
+ (unless (probe-file file)
+ (return-from read-dict NIL))
+ (with-open-file (in file)
+ (with-dictionary-io-syntax
+ (normalize-dict
+ (loop :for word := (read in nil in) :until (eq word in)
+ :collect word)))))
(defun save-dict (&key (file *dict-file*))
"Save the dictionary data into a file."
- (with-open-file (out file :direction :output :if-exists :supersede)
- (with-standard-io-syntax
- (dolist (word (entries-of *dict*)) (print word out)))))
+ (unless (probe-file file)
+ (ensure-directories-exist file))
+ (with-open-file (out file
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (with-dictionary-io-syntax
+ (let ((*package* #.*package*))
+ (dolist (word (entries-of *dict*)) (print word out))))))
(defun dump-dict (&key score-threshold)
"Print the dictionary in CSV format."
(let ((output (format nil "~{~{~A~^,~}~%~}"
(if (null score-threshold)
- (entries-of *dict*) ;score-thresholdが指定されない場合は全件
- (remove nil ;score-thresholdが指定された場合は絞り込む
- (mapcar (lambda (e)
- (if (<= (entry-score e) score-threshold)
- e))
- (entries-of *dict*)))))))
+ (entries-of *dict*) ; score-thresholdが指定されない場合は全件
+ (delete NIL ; score-thresholdが指定された場合は絞り込む
+ (mapcar (lambda (e)
+ (if (<= (entry-score e) score-threshold)
+ e
+ NIL))
+ (entries-of *dict*)))))))
#-ABCL (format t "~A" output)
#+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output)))
@@ -324,7 +330,6 @@
(1 #\N)
(2 #\Q)))
-
(defun prompt-read (prompt)
#-ABCL (progn
(p "~A: " prompt)