最新のもの: Gauche:Bugs
(lambda () (let ()
1 ; <-(a)
(define foo 1)))
他のSchemeの処理系では上の(a)の位置にあるオブジェクトの種類や前後の状況によってエラーになったりならなかったり、あるいは(a)の部分が何であっても全くエラーが起きなかったりするようです。私は(a)相当の位置でデバッグ用の画面表示を行なう時にこの問題に遭遇しました。
今はこの問題を回避するようにプログラムを書きなおしましたがこの問題が解決するとありがたいです。
(lambda () (let ((foo #f))
1
(set! foo 1)))
(lambda () (let ()
(define foo #?=1)
foo))
2007/01/12 17:34:57 PST: errorf を使うべきであろうところに error が使われていると思われるところがいくつかありました。 パッチはテストしてません。参考にしてください。
Index: doc/corelib.texi
===================================================================
RCS file: /cvsroot/gauche/Gauche/doc/corelib.texi,v
retrieving revision 1.127
diff -u -r1.127 corelib.texi
--- doc/corelib.texi 12 Jan 2007 02:21:34 -0000 1.127
+++ doc/corelib.texi 13 Jan 2007 01:25:07 -0000
@@ -4296,8 +4296,8 @@
(map string->number (list yyyy mm dd)))
((rxmatch #/^\d+\/\d+\/\d+$/ str)
(#f)
- (error "ambiguous: ~s" str))
- (else (error "bogus: ~s" str))))
+ (errorf "ambiguous: ~s" str))
+ (else (errorf "bogus: ~s" str))))
(parse-date "2001/2/3") @result{} (2001 2 3)
(parse-date "12/25/1999") @result{} (1999 12 25)
@@ -4419,8 +4419,8 @@
(#/^(\d\d\d\d)\/(\d\d?)\/(\d\d?)$/ (#f yyyy mm dd)
(map string->number (list yyyy mm dd)))
(#/^\d+\/\d+\/\d+$/ (#f)
- (error "ambiguous: ~s" str))
- (else (error "bogus: ~s" str))))
+ (errorf "ambiguous: ~s" str))
+ (else (errorf "bogus: ~s" str))))
@end example
@end defmac
Index: lib/srfi-14.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/srfi-14.scm,v
retrieving revision 1.12
diff -u -r1.12 srfi-14.scm
--- lib/srfi-14.scm 20 Nov 2003 16:12:12 -0000 1.12
+++ lib/srfi-14.scm 13 Jan 2007 01:25:08 -0000
@@ -256,8 +256,8 @@
(if c
(%char-set-add-range! base c c)
(if error?
- (error "unicode character #\\u~8,'0x is not supported in the native character set (~a)"
- i (gauche-character-encoding)))))
+ (errorf "unicode character #\\u~8,'0x is not supported in the native character set (~a)"
+ i (gauche-character-encoding)))))
)))
)
))
Index: lib/gauche/interpolate.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/gauche/interpolate.scm,v
retrieving revision 1.6
diff -u -r1.6 interpolate.scm
--- lib/gauche/interpolate.scm 21 Apr 2005 04:54:28 -0000 1.6
+++ lib/gauche/interpolate.scm 13 Jan 2007 01:25:08 -0000
@@ -66,7 +66,7 @@
(let* ((item
(with-error-handler
(lambda (e)
- (error "unmatched parenthesis in interpolating string: ~s" str))
+ (errorf "unmatched parenthesis in interpolating string: ~s" str))
(lambda () (read))))
(rest
(accum (read-char) (open-output-string))))
Index: lib/gauche/package.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/gauche/package.scm,v
retrieving revision 1.6
diff -u -r1.6 package.scm
--- lib/gauche/package.scm 16 May 2004 20:40:26 -0000 1.6
+++ lib/gauche/package.scm 13 Jan 2007 01:25:08 -0000
@@ -101,8 +101,8 @@
(define (path->gauche-package-description path)
(with-error-handler
(lambda (e)
- (error "couldn't read the package description ~s: ~a" path
- (ref e 'message)))
+ (errorf "couldn't read the package description ~s: ~a" path
+ (ref e 'message)))
(lambda ()
(call-with-input-file path
(lambda (in)
Index: lib/text/html-lite.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/text/html-lite.scm,v
retrieving revision 1.14
diff -u -r1.14 html-lite.scm
--- lib/text/html-lite.scm 21 May 2004 11:10:11 -0000 1.14
+++ lib/text/html-lite.scm 13 Jan 2007 01:25:08 -0000
@@ -122,7 +122,7 @@
(lambda args
(receive (attr args) (get-attr args '())
(unless (null? args)
- (error "element ~s can't have content: ~s" args))
+ (errorf "element ~s can't have content: ~s" name args))
(list "<" name attr " />")))
(lambda args
(receive (attr args) (get-attr args '())
Index: src/compile.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/src/compile.scm,v
retrieving revision 1.50
diff -u -r1.50 compile.scm
--- src/compile.scm 10 Dec 2006 03:46:40 -0000 1.50
+++ src/compile.scm 13 Jan 2007 01:25:09 -0000
@@ -3654,7 +3654,7 @@
(renv-diff (list-remove-prefix ($call-renv embed-node)
(reverse renv))))
(unless renv-diff
- (error "[internal error] $call[jump] appeared out of context of related $call[embed] (~s vs ~s)" ($call-renv embed-node) renv))
+ (errorf "[internal error] $call[jump] appeared out of context of related $call[embed] (~s vs ~s)" ($call-renv embed-node) renv))
(if (tail-context? ctx)
(let1 dinit (pass3/prepare-args args ccb renv ctx)
(compiled-code-emit1oi! ccb LOCAL-ENV-JUMP (length renv-diff)
Index: src/geninsn
===================================================================
RCS file: /cvsroot/gauche/Gauche/src/geninsn,v
retrieving revision 1.3
diff -u -r1.3 geninsn
--- src/geninsn 23 Aug 2005 04:33:56 -0000 1.3
+++ src/geninsn 13 Jan 2007 01:25:09 -0000
@@ -274,7 +274,7 @@
:combined (get-optional maybe-combined '()))
)
(else
- (error "unrecognized form: ~s" insn))))
+ (errorf "unrecognized form: ~s" insn))))
(file->sexp-list (get-optional (cdr args) "vminsn.scm")))
(cgen-extern " SCM_VM_NUM_INSNS" "};")
Index: test/object.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/test/object.scm,v
retrieving revision 1.38
diff -u -r1.38 object.scm
--- test/object.scm 5 Mar 2006 07:48:38 -0000 1.38
+++ test/object.scm 13 Jan 2007 01:25:09 -0000
@@ -1282,7 +1282,7 @@
(apply-methods gf (sort-applicable-methods gf applicable-methods args) args)
(let loop1 ((methods (slot-ref gf 'methods)))
(if (null? methods)
- (error "no applicable method for ~S with arguments ~S" gf args)
+ (errorf "no applicable method for ~S with arguments ~S" gf args)
(let ((method (car methods)))
(let loop2 ((specs (slot-ref method 'specializers))
(a args)
(2007/01/10 21:05:35 PST): SLIB 3a4 付属文書(ANNOUNCE)から引用
*.init, Template.scm, require.scm (slib:features): Renamed from *features* to avoid conflict with Guile identifier.
このため SLIB モジュールの make install が失敗します。参考：Debian Bug report logs - #400556
gemma(2007/01/09 06:37:37 PST):自分の勘違いかもしれませんが。
GaucheRefj:open-input-process-port
キーワードはinputでは？それに付随して、本文にもいくつか。
GaucheRefj:call-with-input-process GaucheRefj:with-input-from-process
も同様。
対のGaucheRefj:open-output-process-portなども同様に、入力と出力とが逆になっているのでは。
gemma (2007/01/07 20:28:57 PST):
(socket-input-port client :buffered? #f)
buffered? キーワードは古いのでは。
gemma (2007/01/07 20:28:57 PST):
srfi-1
(define match (#/(?<integer>\d+)\.(?<fraction>(\d+)/ "pi=3.14..."))
↑<fraction>の後ろの、強調したところのカッコはいらない。正しくは↓だと思う。
(define match (#/(?<integer>\d+)\.(?<fraction>\d+)/ "pi=3.14..."))
Shiro(2007/01/11 16:32:42 PST): 修正しました。
Rui (2006/12/30 20:18:25 PST): NOHUNGキーワードに#tを渡したとき、終了した子プロセスがなければどうなるのかについての記述がマニュアルにないようです。実際にはエラーが上がります。
gosh> (sys-waitpid -1 :nohang #t) *** SYSTEM-ERROR: waitpid() failed: No child processes
Rui (2006/12/25 16:13:28 PST): sys-truncateとsys-ftruncateがマニュアルに載っていないようです。
SCM_EXTERN char **Scm_ListToCStringArray(ScmObj lis, int errp,
void *alloc(size_t));
(use slib)すると
*** ERROR: Compile Error: unbound variable: slib:features
になります。 slib 3a4のANNOUNCEによると、*features*が slib:featuresに変更されたようです。 手元では
(define slib:features *features*)
でエラーは出なくなりました。
--- Gauche-0.8.8/lib/slib.scm.in.orig 2005-07-12 10:01:07.000000000 +0900
+++ Gauche-0.8.8/lib/slib.scm.in 2006-11-18 05:16:23.000000000 +0900
@@ -1,4 +1,4 @@
-;;; "slib.scm" configuration template of *features* for Scheme -*-scheme-*-
+;;; "slib.scm" configuration template of slib:features for Scheme -*-scheme-*-
;;; Author: Shiro Kawai
;;; based on the "Template.scm" by Aubrey Jaffer
;;;
@@ -14,40 +14,34 @@
(export-all))
(select-module slib)
-;;; (software-type) should be set to the generic operating system type.
-;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
-
+;;@ (software-type) should be set to the generic operating system type.
+;;; unix, vms, macos, amiga and ms-dos are supported.
(define software-type
- (let ((t (if (#/-mingw32$/ (gauche-architecture)) 'MS-DOS 'UNIX)))
+ (let ((t (if (#/-mingw32$/ (gauche-architecture)) 'ms-dos 'unix)))
(lambda () t)))
-;;; (scheme-implementation-type) should return the name of the scheme
+;;@ (scheme-implementation-type) should return the name of the scheme
;;; implementation loading this file.
-
(define (scheme-implementation-type) 'gauche)
-;;; (scheme-implementation-home-page) should return a (string) URL
-;;; (Uniform Resource Locator) for this scheme implementation's home
+;;@ (scheme-implementation-home-page) should return a (string) URI
+;;; (Uniform Resource Identifier) for this scheme implementation's home
;;; page; or false if there isn't one.
-
(define (scheme-implementation-home-page)
- "http://www.shiro.dreamhost.com/scheme/gauche")
+ "http://practical-scheme.net/gauche/")
-;;; (scheme-implementation-version) should return a string describing
+;;@ (scheme-implementation-version) should return a string describing
;;; the version the scheme implementation loading this file.
-
(define (scheme-implementation-version) (gauche-version))
-;;; (implementation-vicinity) should be defined to be the pathname of
+;;@ (implementation-vicinity) should be defined to be the pathname of
;;; the directory where any auxillary files to your Scheme
;;; implementation reside.
-
(define (implementation-vicinity)
(string-append (gauche-library-directory) "/"))
-;;; (library-vicinity) should be defined to be the pathname of the
+;;@ (library-vicinity) should be defined to be the pathname of the
;;; directory where files of Scheme library functions reside.
-
(define library-vicinity
(let ((library-path
(or
@@ -56,21 +50,63 @@
;; Use this path if your scheme does not support GETENV
;; or if SCHEME_LIBRARY_PATH is not set.
(case (software-type)
- ((UNIX) "@SLIB_DIR@/")
- ((VMS) "lib$scheme:")
- ((MS-DOS) "C:\\SLIB\\")
+ ((unix) "@SLIB_DIR@/")
+ ((vms) "lib$scheme:")
+ ((ms-dos) "C:\\SLIB\\")
(else "")))))
(lambda () library-path)))
-; by dai 2005-07-04 borrowed from Init5e1.scm
-(define *load-pathname* #f)
+;;@ (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+(define (home-vicinity)
+ (let ((home (sys-getenv "HOME")))
+ (and home
+ (case (software-type)
+ ((unix coherent ms-dos) ;V7 unix has a / on HOME
+ (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
+ home
+ (string-append home "/")))
+ (else home)))))
+
+;@
+(define in-vicinity string-append)
+;@
(define (user-vicinity)
(case (software-type)
- ((VMS) "[.]")
+ ((vms) "[.]")
(else "")))
+
+(define *load-pathname* #f)
+;@
+(define vicinity:suffix?
+ (let ((suffi
+ (case (software-type)
+ ((amiga) '(#\: #\/))
+ ((macos thinkc) '(#\:))
+ ((ms-dos windows atarist os/2) '(#\\ #\/))
+ ((nosve) '(#\: #\.))
+ ((unix coherent plan9) '(#\/))
+ ((vms) '(#\: #\]))
+ (else
+ (slib:warn "require.scm" 'unknown 'software-type (software-type))
+ "/"))))
+ (lambda (chr) (and (memv chr suffi) #t))))
+;@
+(define (pathname->vicinity pathname)
+ (let loop ((i (- (string-length pathname) 1)))
+ (cond ((negative? i) "")
+ ((vicinity:suffix? (string-ref pathname i))
+ (substring pathname 0 (+ i 1)))
+ (else (loop (- i 1))))))
+(define (program-vicinity)
+ (if *load-pathname*
+ (pathname->vicinity *load-pathname*)
+ (slib:error 'program-vicinity " called; use slib:load to load")))
+;@
(define sub-vicinity
(case (software-type)
- ((VMS) (lambda
+ ((vms) (lambda
(vic name)
(let ((l (string-length vic)))
(if (or (zero? (string-length vic))
@@ -80,12 +116,15 @@
"." name "]")))))
(else (let ((*vicinity-suffix*
(case (software-type)
- ((NOSVE) ".")
- ((MACOS THINKC) ":")
- ((MS-DOS WINDOWS ATARIST OS/2) "\\")
- ((UNIX COHERENT PLAN9 AMIGA) "/"))))
+ ((nosve) ".")
+ ((macos thinkc) ":")
+ ((ms-dos windows atarist os/2) "\\")
+ ((unix coherent plan9 amiga) "/"))))
(lambda (vic name)
(string-append vic name *vicinity-suffix*))))))
+;@
+(define (make-vicinity <pathname>) <pathname>)
+;@
(define with-load-pathname
(let ((exchange
(lambda (new)
@@ -99,32 +138,21 @@
thunk
(lambda () (exchange old)))))))
-(define-constant *dir-sep* "/")
-
-;;; (home-vicinity) should return the vicinity of the user's HOME
-;;; directory, the directory which typically contains files which
-;;; customize a computer environment for a user.
-
-(define home-vicinity
- (let* ((home-path (or (home-directory) (sys-getenv "HOME")))
- (home-dir (if (string-suffix? *dir-sep* home-path)
- home-path
- (string-append home-path *dir-sep*))))
- (lambda () home-dir)))
-
-;;; *FEATURES* should be set to a list of symbols describing features
-;;; of this implementation. Suggestions for features are:
-
-(define *features*
+;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features
+;;; initially supported by this implementation.
+(define slib:features
'(
source ;can load scheme source files
- ;(slib:load-source "filename")
-; compiled ;can load compiled files
- ;(slib:load-compiled "filename")
+ ;(SLIB:LOAD-SOURCE "filename")
+;;; compiled ;can load compiled files
+ ;(SLIB:LOAD-COMPILED "filename")
+ vicinity
+ srfi-59
;; Scheme report features
+ ;; R5RS-compliant implementations should provide all 9 features.
- rev5-report ;conforms to
+ r5rs ;conforms to
eval ;R5RS two-argument eval
values ;R5RS multiple values
dynamic-wind ;R5RS dynamic-wind
@@ -132,41 +160,42 @@
delay ;has DELAY and FORCE
multiarg-apply ;APPLY can take more than 2 args.
char-ready?
+ rev4-optional-procedures ;LIST-TAIL, STRING-COPY,
+ ;STRING-FILL!, and VECTOR-FILL!
+
+ ;; These four features are optional in both R4RS and R5RS
+
+ multiarg/and- ;/ and - can take more than 2 args.
; rationalize
- rev4-optional-procedures ;LIST-TAIL, STRING->LIST,
- ;LIST->STRING, STRING-COPY,
- ;STRING-FILL!, LIST->VECTOR,
- ;VECTOR->LIST, and VECTOR-FILL!
+;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF
+ with-file ;has WITH-INPUT-FROM-FILE and
+ ;WITH-OUTPUT-TO-FILE
- rev4-report ;conforms to
+ r4rs ;conforms to
ieee-p1178 ;conforms to
-; rev3-report ;conforms to
+;;; r3rs ;conforms to
-; rev2-procedures ;SUBSTRING-MOVE-LEFT!,
+;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!,
;SUBSTRING-MOVE-RIGHT!,
;SUBSTRING-FILL!,
;STRING-NULL?, APPEND!, 1+,
;-1+, <?, <=?, =?, >?, >=?
-; object-hash ;has OBJECT-HASH
+;;; object-hash ;has OBJECT-HASH
- multiarg/and- ;/ and - can take more than 2 args.
- with-file ;has WITH-INPUT-FROM-FILE and
- ;WITH-OUTPUT-FROM-FILE
-; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF
+ full-continuation ;can return multiple times
ieee-floating-point ;conforms to IEEE Standard 754-1985
;IEEE Standard for Binary
;Floating-Point Arithmetic.
- full-continuation ;can return multiple times
;; Other common features
- ;; NB: we turned off srfi here, since if this is on, slib tries
- ;; to import all available srfis, including srfi-29, which defines
- ;; incompatible 'format'.
+ ;; NB: we turned off srfi here, since if this is on, slib tries
+ ;; to import all available srfis, including srfi-29, which defines
+ ;; incompatible 'format'.
; srfi ;srfi-0, COND-EXPAND finds all srfi-*
-; sicp ;runs code from Structure and
+;;; sicp ;runs code from Structure and
;Interpretation of Computer
;Programs by Abelson and Sussman.
defmacro ;has Common Lisp DEFMACRO
@@ -174,87 +203,90 @@
string-port ;has CALL-WITH-INPUT-STRING and
;CALL-WITH-OUTPUT-STRING
sort
-; pretty-print
+;;; pretty-print
object->string
-; format ;Common-lisp output formatting
-; trace ;has macros: TRACE and UNTRACE
-; compiler ;has (COMPILER)
-; ed ;(ED) is editor
+;;; format ;Common-lisp output formatting
+;;; trace ;has macros: TRACE and UNTRACE
+;;; compiler ;has (COMPILER)
+;;; ed ;(ED) is editor
system ;posix (system <string>)
getenv ;posix (getenv <string>)
program-arguments ;returns list of strings (argv)
current-time ;returns time in seconds since 1/1/1970
;; Implementation Specific features
- byte ;byte string manipulation
+ byte ;byte string manipulation
))
-;;; (OUTPUT-PORT-WIDTH <port>)
+;;@ (OUTPUT-PORT-WIDTH <port>)
(define (output-port-width . arg) 79)
-;;; (OUTPUT-PORT-HEIGHT <port>)
+;;@ (OUTPUT-PORT-HEIGHT <port>)
(define (output-port-height . arg) 24)
-;;; (CURRENT-ERROR-PORT) - Gauche has it
+;;@ (CURRENT-ERROR-PORT) - Gauche has it
;(define current-error-port
; (let ((port (current-output-port)))
; (lambda () port)))
-;;; (TMPNAM) makes a temporary file name.
+;;@ (TMPNAM) makes a temporary file name.
(define tmpnam sys-tmpnam)
-;;; SYSTEM
+;;@ SYSTEM
(define system sys-system)
-;;; GETENV
+;;@ GETENV
(define getenv sys-getenv)
-;;; (FILE-EXISTS? <string>)
+;;@ (FILE-EXISTS? <string>)
; Gauche has this
-;;; (DELETE-FILE <string>)
-(define (delete-file f) (sys-unlink f))
+;;@ (DELETE-FILE <string>)
+(define (delete-file f) (sys-unlink f))
-;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;@ FORCE-OUTPUT flushes any pending output on optional arg output port
;;; use this definition if your system doesn't have such a procedure.
-(define force-output flush)
+(define (force-output . arg) #t)
-;; CURRENT-TIME
+;;@ CURRENT-TIME
(define current-time sys-time)
-;; PROGRAM-ARGUMENTS
+;;@ PROGRAM-ARGUMENTS
(define (program-arguments) (with-module gauche *argv*))
;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
;;; port versions of CALL-WITH-*PUT-FILE.
-;;; "rationalize" adjunct procedures.
+;;@ "rationalize" adjunct procedures.
;;(define (find-ratio x e)
;; (let ((rat (rationalize x e)))
;; (list (numerator rat) (denominator rat))))
;;(define (find-ratio-between x y)
;; (find-ratio (/ (+ x y) 2) (/ (- x y) 2)))
-;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;@ CHAR-CODE-LIMIT is one greater than the largest integer which can
;;; be returned by CHAR->INTEGER.
(define char-code-limit (+ *char-code-max* 1))
-;;; MOST-POSITIVE-FIXNUM is used in modular.scm
-;; NB: this should be architecture dependent.
-(define most-positive-fixnum #x0FFFFFFF)
+;;@ MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum (let ()
+ (define (%fixnum-find-max n)
+ (if (fixnum? n)
+ (%fixnum-find-max (ash n 1))
+ (- n 1)))
+ (%fixnum-find-max 1)))
-;;; Return argument
-;(define (identity x) x) Gauche has this.
+;;@ Return argument
+;(define (identity x) x) ; Gauche has this.
-;;; SLIB:EVAL is single argument eval using the top-level (user) environment.
+;;@ SLIB:EVAL is single argument eval using the top-level (user) environment.
(define (slib:eval expr) (eval expr (interaction-environment)))
-;;; %SLIB-LOAD loads file in slib module.
+;; If your implementation provides R4RS macros:
+(define macro:eval slib:eval)
+;;@ %SLIB-LOAD loads file in slib module.
(define (%slib-load file)
(with-module slib (load file)))
-
-;;; If your implementation provides R4RS macros:
-(define macro:eval slib:eval)
(define macro:load %slib-load)
(define-syntax defmacro
@@ -264,38 +296,30 @@
;; Gauche has these
; macroexpand-1
; macroexpand
-
-(define gentemp gensym)
+;@
+(define (gentemp) (gensym "slib:G"))
(define base:eval slib:eval)
+;@
;(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+
;(define (defmacro:expand* x)
; (require 'defmacroexpand) (apply defmacro:expand* x '()))
-
-;(define (slib:eval-load <pathname> evl)
-; (if (not (file-exists? <pathname>))
-; (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
-; (call-with-input-file <pathname>
-; (lambda (port)
-; (let ((old-load-pathname *load-pathname*))
-; (set! *load-pathname* <pathname>)
-; (do ((o (read port) (read port)))
-; ((eof-object? o))
-; (evl o))
-; (set! *load-pathname* old-load-pathname)))))
-
+;@
(define defmacro:load %slib-load)
-
+;; slib:eval-load definition moved to "require.scm"
+;@
(define slib:warn
(lambda args
(let ((cep (current-error-port)))
(if (provided? 'trace) (print-call-stack cep))
(display "Warn: " cep)
- (for-each (lambda (x) (display x cep)) args))))
+ (for-each (lambda (x) (display #\space cep) (write x cep)) args)
+ (newline cep))))
-;;; define an error procedure for the library
+;;@ define an error procedure for the library
(define slib:error error)
-
+;@
(define (make-exchanger obj)
(lambda (rep) (let ((old obj)) (set! obj rep) old)))
(define (open-file filename modes)
@@ -303,7 +327,7 @@
((r rb) (open-input-file filename))
((w wb) (open-output-file filename))
(else (slib:error 'open-file 'mode? modes))))
-(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (port? obj) (or (input-port? obj) (output-port? obj)))
(define (call-with-open-ports . ports)
(define proc (car ports))
(cond ((procedure? proc) (set! ports (cdr ports)))
@@ -319,13 +343,20 @@
(if (output-port? port) (close-output-port port)))
((output-port? port) (close-output-port port))
(else (slib:error 'close-port 'port? port))))
+;@
+(define (browse-url url)
+ (define (try cmd end) (zero? (system (string-append cmd url end))))
+ (or (try "netscape-remote -remote 'openURL(" ")'")
+ (try "netscape -remote 'openURL(" ")'")
+ (try "netscape '" "'&")
+ (try "netscape '" "'")))
-;;; define these as appropriate for your system.
+;;@ define these as appropriate for your system.
(define slib:tab (integer->char 9))
(define slib:form-feed (integer->char 12))
-;;; Support for older versions of Scheme. Not enough code for its own file.
-;(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))
+;;@ Support for older versions of Scheme. Not enough code for its own file.
+;(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) ; Gauche has this.
(define t #t)
(define nil #f)
@@ -350,39 +381,33 @@
;; write-byte - Gauche has this
;; read-byte - Gauche has this
-;;; Define these if your implementation's syntax can support it and if
+;;@ Define these if your implementation's syntax can support it and if
;;; they are not already defined.
+(define (1+ n) (+ n 1))
+(define (-1+ n) (+ n -1))
+(define 1- -1+)
-;(define (1+ n) (+ n 1))
-;(define (-1+ n) (+ n -1))
-;(define 1- -1+)
-
-(define in-vicinity string-append)
-
-;;; Define SLIB:EXIT to be the implementation procedure to exit or
-;;; return if exitting not supported.
+;;@ Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exiting not supported.
(define slib:exit exit)
-;;; Here for backward compatability
+;;@ Here for backward compatability
(define scheme-file-suffix
(let ((suffix (case (software-type)
- ((NOSVE) "_scm")
+ ((nosve) "_scm")
(else ".scm"))))
(lambda () suffix)))
-;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
;;; suffix all the module files in SLIB have. See feature 'SOURCE.
-
(define (slib:load-source f) (load (string-append f ".scm")))
-;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;@ (SLIB:LOAD-COMPILED "foo") should load the file that was produced
;;; by compiling "foo.scm" if this implementation can compile files.
;;; See feature 'COMPILED.
-
(define slib:load-compiled load)
-;;; At this point SLIB:LOAD must be able to load SLIB files.
-
+;;@ At this point SLIB:LOAD must be able to load SLIB files.
(define slib:load load)
(slib:load (in-vicinity (library-vicinity) "require"))
enami(2006/11/16 15:33:54 PST): 下で書いたのも含めて、最近読んでいて気がついたものです。
Index: doc/coresyn.texi
===================================================================
RCS file: /cvsroot/gauche/Gauche/doc/coresyn.texi,v
retrieving revision 1.27
diff -u -0 -r1.27 coresyn.texi
--- doc/coresyn.texi 16 Nov 2006 06:08:01 -0000 1.27
+++ doc/coresyn.texi 16 Nov 2006 23:29:26 -0000
@@ -1677 +1677 @@
-これらの構文は準クォートさた@var{template}内にあるときにだけ意味を持ち
+これらの構文は準クォートされた@var{template}内にあるときにだけ意味を持ち
@@ -1801 +1801 @@
-くら静的か」を見てください。
+くらい静的か」を見てください。
@@ -1885 +1885 @@
-さらにアンクォート式が定数式の場合，Gacheはそれを準クォートの固定部分
+さらにアンクォート式が定数式の場合，Gaucheはそれを準クォートの固定部分
Index: src/gauche/port.h
===================================================================
RCS file: /cvsroot/gauche/Gauche/src/gauche/port.h,v
retrieving revision 1.17
diff -u -0 -r1.17 port.h
--- src/gauche/port.h 5 Nov 2006 11:11:47 -0000 1.17
+++ src/gauche/port.h 16 Nov 2006 23:29:27 -0000
@@ -379 +379 @@
- * (It doesn't make much sense for multiple threads to writeto the
+ * (It doesn't make much sense for multiple threads to write to the
@@ -436 +436 @@
- TODO: we may be ablet to utilize SCM_PORT_PRIVATE flag to avoid
+ TODO: we may be able to utilize SCM_PORT_PRIVATE flag to avoid
Rui(2006/11/15 17:47:27 PST): 次のプログラムを実行するとsegmentation faultしてしまいました。
(define-condition-type &c <condition> #f) (with-error-handler values (error &c))
Rui(2006/11/14 06:24:29 PST): Texinfoで、"@"を出力するところで"@@"としていない箇所がありました。
--- doc/modutil.texi 12 Nov 2006 11:13:03 -0000 1.93 +++ doc/modutil.texi 14 Nov 2006 14:18:22 -0000 @@ -10946,3 +10946,3 @@ - (cond-list (x @ `(:x ,x)) - (y @ `(:y ,y)) - (z @ `(:z ,z)))) + (cond-list (x @@ `(:x ,x)) + (y @@ `(:y ,y)) + (z @@ `(:z ,z))))
また、cond-listのclauseがtestだけの([cond-list (test)]のような)場合についての記述がないのは意図したとおりでしょうか? 便利なので正式サポートしてほしいです。
leque(2006/11/13 03:00:13 PST): (negative? #i0/0) が常に真になります。
gosh> (negative? #i0/0) #t gosh> (positive? #i0/0) #f gosh> (zero? #i0/0) #f
また、= で NaN と他の数を比較すると任意の数について #t を返します。
% gosh -fno-inline gosh> (= #i0/0 0) #t gosh> (= #i0/0 #i0/0) #t gosh> (= 3 #i0/0) #t
enami(2006/11/12 06:27:10 PST): PORT_LOCK() の実装ですが、複数の thread が port を奪いあう場合、少なくとも lock できなかった thread が cpu を浪費するのではないかと思います。そして、 他に cpu bound な process がいた場合、その邪魔をしてしまうのではないでしょうか？ また、NetBSD (2.0G, 3.1_STABLE) の場合、0.8.7 (あるいは、 陽に mutex/condvar を使った場合) に較べて performance が落ちているようです。 (c.f. http://www.lingr.com/room/gbq0WCLQEF2/archives/2006/11/12)
Shiro(2006/11/12 11:55:03 PST): コードのコメントにも書いてありますが、この実装は 「現実的には、正しいプログラムではportへのアクセスは競合しない」ということを 前提にしています。portへのアクセスが競合するということは入出力が予測不可能な 形で混ざることであり、そのような入出力の利用価値があるとは思えない、という のが理由です。portのロックはsloppyなプログラムがportの内部状態を 壊してしまうことを防ぐsafety netという位置付けです。
現在の実装では一番外側の入出力プリミティブがportにロックをかけますが、 これは性能的な要請からそうしているもので、入出力プリミティブ自体のatomicity を保証するという意図ではありません (このへん、ドキュメントで明確に しておいた方が良いですね---たとえば複数スレッドがwriteで同一portに 書いたものが混ざらないということが将来に渡って保証されるとは限らないって ことです)。ちゃんとした入出力をやりたいならそのへんは アプリ側で管理して欲しい、という立場です。
デバッグ用の出力が競合する場合というのは現実的に考えられますが、それは あくまでデバッグ用であって、成果物からはそれは除かれると考えます。 デバッグ時には性能より利便性を優先するという観点です。
ただ、この前提では実用的に不便なケースがあれば直すことは構いません。
あと、mutex/condvarの方が性能が出るというのは興味深いです。 port競合が無い状態でもそちらの方が速いなら、プラットフォームによって 切り替えることも考えます。
あーもしかして。ErlangやKL1みたいにデータのavailabilityで同期を取る (ひとつの入力を複数スレッドで待ってて、データが届いたらどれか一つが それを掴む)ようなイディオムをportに対して使われるときついのか。 これは、そういう使い方はしないでくださいと言うしかないなあ。
enami(2006/11/13 17:03:27 PST): あ、その port.h のコメントは確かに以前読んだのに すっかり忘れていました(ちなみに、writeto は typo ですね)。そういう実装方針であり、 意図してやっているということで、了解しました。
mutex/condvar は、さすがに競合がない状態では遅いです(test/port-performace.scm)。 実装の癖を知っておくのは大事だと思うので、document で明確にするのは賛成です。 競合すると busy になるというのは、最初は聞くとびっくりすると思うので。
Shiro(2007/01/07 02:50:59 PST): 記述を追加しました。
enami(2006/11/12 05:27:47 PST): たいしたことではないですが、copy-port で unit が 0 の時の block size が 4096 でなく 4196 なのは何か意図があってか、それとも単なる typo かどちらでしょうか？