Gauche:Bugs:log8

Gauche:Bugs:log8

最新のもの: Gauche:Bugs

lambdaの中でletとdefineを使うと使用順によってsyntax-errorが起きる (0.8.8)

possible misuse of error where errorf was intended (cvs head)

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)

SLIB 3a4 での変数名変更による影響で make install 失敗(0.8.8)

(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

open-input-process-port と open-output-process-port のマニュアル(0.8.8)

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なども同様に、入力と出力とが逆になっているのでは。

example/echo-server.scm の buffered? キーワード(0.8.8)

gemma (2007/01/07 20:28:57 PST):

 (socket-input-port client :buffered? #f)

buffered? キーワードは古いのでは。

srfi-1,array-length,regmatch,dbm-db-exists?のマニュアル(0.8.8)

gemma (2007/01/07 20:28:57 PST):
srfi-1

GaucheRefj:array-length

GaucheRefj:正規表現

 (define match (#/(?<integer>\d+)\.(?<fraction>(\d+)/ "pi=3.14..."))
↑<fraction>の後ろの、強調したところのカッコはいらない。正しくは↓だと思う。
(define match (#/(?<integer>\d+)\.(?<fraction>\d+)/ "pi=3.14..."))

GaucheRefj:dbm-db-exists?

Shiro(2007/01/11 16:32:42 PST): 修正しました。

sys-waitpidのマニュアル (0.8.8)

Rui (2006/12/30 20:18:25 PST): NOHUNGキーワードに#tを渡したとき、終了した子プロセスがなければどうなるのかについての記述がマニュアルにないようです。実際にはエラーが上がります。

gosh> (sys-waitpid -1 :nohang #t)
*** SYSTEM-ERROR: waitpid() failed: No child processes

sys-truncate、sys-ftruncateがマニュアルにない (0.8.8)

Rui (2006/12/25 16:13:28 PST): sys-truncateとsys-ftruncateがマニュアルに載っていないようです。

gauche.hのScm_ListToCStringArrayの宣言がおかしい

Autoconf 2.60 で作成されたconfigureスクリプトを実行すると警告が出る。(0.8.8)

最新のslib(3a4)だと(use slib)でエラー (0.8.8)

(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"))

typos (cvs head)

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

Segmentation fault (0.8.8)

Rui(2006/11/15 17:47:27 PST): 次のプログラムを実行するとsegmentation faultしてしまいました。

(define-condition-type &c <condition> #f)
(with-error-handler values (error &c))

cond-listのマニュアル (0.8.8)

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)]のような)場合についての記述がないのは意図したとおりでしょうか? 便利なので正式サポートしてほしいです。

comparison with NaN (0.8.8)

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

about PORT_LOCK() implementation (0.8.8)

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): 記述を追加しました。

block size of copy-port when unit == 0

enami(2006/11/12 05:27:47 PST): たいしたことではないですが、copy-port で unit が 0 の時の block size が 4096 でなく 4196 なのは何か意図があってか、それとも単なる typo かどちらでしょうか?


Last modified : 2009/03/08 02:03:18 UTC