[gambit-list] blackhole fixes

moochee at gmx.net moochee at gmx.net
Sun Jul 26 07:51:25 EDT 2009


Hello dear all,

while trying to port Alex Shinn's fmt to blackhole (not finished yet)
i faced some difficulties resulting in the attached patch.  I am neither
familiar with black hole nor with the subleties of gambit.  I hope
this is the right place for discussion.  The Black-Hole page seems to
be unreachable for several days now.

let-optionals:
the hunk addressing optionals changes ,,body ...'' in

(let-optionals* arglst ((var default) ...) body ...)

to be wrapped into a let-form instead of a begin-form.  This is what
fmt seems to expect as the body starts with define-expressions leading
to a complaint of gambit about misplaced expressions.

Of course i could modify the fmt code to solve the problem at hand.
But as the code seems to be working on other schemes it might be what
other schemers expect.  At least i don't see any drawbacks from doing
so.  As the begin-expresion will be wrapped into an outer
let-expression anyway this modification should be completely
transparent besides the gain expressive freedom.


srfi/13 string-index:
The result of an argument sanity check was passed along instead of the
checked argument itself.


srfi/13 char-cased char-titlecase:
These are quick hacks.  I didn't find them defined anywhere.  Not sure
whether this actually led to an error or not.


srfi/14 char-set?:
Black hole seems not to deal correctly with define-record-type.
Instead of fixing the cause, i decided to provide this quick hack for
the apparent problem of not exporting ,,char-set?''.

Bye
        Tara
-------------- next part --------------
diff --git a/std/misc/optionals.scm b/std/misc/optionals.scm
index 29a6adc..0d57e9b 100644
--- a/std/misc/optionals.scm
+++ b/std/misc/optionals.scm
@@ -154,7 +154,7 @@
     ;; No more vars. Make sure there are no unaccounted-for values, and
     ;; do the body.
     ((really-let-optionals* args () body1 ...)
-     (if (null? args) (begin body1 ...)
+     (if (null? args) (let () body1 ...)
          (error "Too many optional arguments." args)))))
 
 (define-syntax let-optionals*
diff --git a/std/srfi/13.scm b/std/srfi/13.scm
index 65fb986..adf583d 100644
--- a/std/srfi/13.scm
+++ b/std/srfi/13.scm
@@ -216,10 +216,14 @@
 	       start substring/shared)
     (%substring/shared s start
 		       (let ((end (:optional maybe-end slen)))
-                         (and (integer? end)
-                              (exact? end)
-                              (<= start end)
-                              (<= end slen))))))
+                         (check-arg (lambda (end)
+                                      (and (integer? end)
+                                           (exact? end)
+                                           (<= start end)
+                                           (<= end slen)))
+                                    end
+                                    substring/shared)
+                         end))))
 
 ;;; Split out so that other routines in this library can avoid arg-parsing
 ;;; overhead for END parameter.
@@ -940,6 +944,18 @@
   (let-string-start+end (start end) string-downcase! s maybe-start+end
     (%string-map! char-downcase s start end)))
 
+;; FIXIME: Assume that letters are encoded from a to z without holes.
+;; Works for ASCII / Unicode.
+(define (char-cased? c)
+  (let ((n (char->integer c)))
+    (and (<= (char->integer #\a) n)
+         (>= (char->integer #\z) n)
+         (<= (char->integer #\A) n)
+         (>= (char->integer #\Z) n))))
+
+;; FIXME: ASCII again
+(define char-titlecase char-upcase)
+
 (define (%string-titlecase! s start end)
   (let lp ((i start))
     (cond ((string-index s char-cased? i end) =>
diff --git a/std/srfi/14.scm b/std/srfi/14.scm
index 005cba9..d6ebf2c 100644
--- a/std/srfi/14.scm
+++ b/std/srfi/14.scm
@@ -90,9 +90,12 @@
 
 (define-record-type :char-set
   (make-char-set s)
-  char-set?
+  char-set?*
   (s char-set:s))
 
+;; Seems black-hole does not deal correctly with define-record-type
+(define char-set? char-set?*)
+
 (define char-set make-char-set)
 
 (define (%string-copy s) (substring s 0 (string-length s)))


More information about the Gambit-list mailing list