~ chicken-core (chicken-5) f7cdd74099210fd262a20b9f4d78896948c8abfb
commit f7cdd74099210fd262a20b9f4d78896948c8abfb
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Dec 11 12:46:22 2011 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Dec 11 12:46:22 2011 +0100
types.db fix (kindly contributed by moritz)
diff --git a/NEWS b/NEWS
index 616099bd..014662e3 100644
--- a/NEWS
+++ b/NEWS
@@ -21,7 +21,7 @@
- deprecated the compiler option "-heap-initial-size", "-heap-growth"
and "-heap-shrinkage"
- the assembly-language stub routine for the implementation of "apply"
- was broken for Sparc64 systems and has been disabled for this platform
+ was broken for Sparc64 systems - has been disabled for this platform
- Core libraries
- added a setter procedure to "signal-handler" ("posix" unit)
@@ -29,11 +29,11 @@
waiting for input
- the implementation of R5RS evaluation environments is now fully
standards compliant
- - "file-exists?" and "directory-exists?" work properly for files
+ - "file-exists?" and "directory-exists?" work now properly for files
> 2GB (EOVERFLOW handling in stat(3) system call)
- fixed bug in implementation of "fifo?"
- the procedure returned by "condition-predicate" accepts any type
- of argument
+ of argument now
- blobs have a readable textual representation ("#{...}")
- "find-files" does not follow symlinks by default (as it did previously)
- also, the old non-keyword argument signature for "find-files" is not
@@ -46,7 +46,7 @@
- deprecated "none?", "always?" and "never?" ("data-structures" unit)
- "parameterize" does not invoke guard procedure when restoring a
parameter's value after execution of the body
- - library procedures that take ports as arguments now perform checks
+ - library procedures that take ports as arguments now all perform checks
on direction and open/closed state
- "mutate-procedure" has been renamed to "mutate-procedure!" - the old
name is still available but deprecated ("lolevel" unit)
@@ -54,7 +54,7 @@
- Compiler
- fixed a bug in the compiler that could cause some variable bindings
to be optimized away in certain situations involving inlining
- - added an experimental optimization called "clustering" (enabled
+ - added an experimental optimization called "clustering" (enable
with the compiler option of the same name)
- the optimizations done by the compiler are now listed inside a comment
in the generated C file
@@ -68,13 +68,13 @@
- Type system
- added new type-specifiers "input-port", "output-port", "(list-of T)"
and "(vector-of T)"
- - the type-specifiers "(vector T ...)" and "(list T ...)" have been
- changed to represent fixed size lists and vectors now
+ - the type-specifiers "(vector T ...)" and "(list T ...)" represent
+ fixed size lists and vectors now
- added qualified types ("forall"), optionally with type constrains
- added the "define-type" special form and type-abbreviations
- "-verbose" now shows scrutinizer-warnings and compiler notices
that are possibly non-critical (otherwise they are not listed)
- - added "compiler-typecase", a compile-time type-matching form
+ - added "compiler-typecase", a compile-time typematching form
- Module system
- the "scheme" module has been integrated into the core library and
@@ -90,10 +90,9 @@
not match
- added new option "-show-foreign-depends" which lists foreign egg
dependencies (if available)
- - added new option "-show-depends" which lists egg dependencies
- Foreign function interface
- - locatives are allowed as arguments declared as "c-pointer"
+ - locatives are allowed as arguments declared "c-pointer"
4.7.3
diff --git a/irregex-core.scm b/irregex-core.scm
index 54413bfe..982f57e4 100644
--- a/irregex-core.scm
+++ b/irregex-core.scm
@@ -1485,7 +1485,7 @@
(map (lambda (_)
`(/ ,(integer->char #x80) ,(integer->char #xFF)))
(zero-to (+ i lo-len))))))
- (zero-to (- (length hi-ls) (+ lo-len 1))))
+ (zero-to (- (length hi-ls) lo-len 1)))
(list
(sre-sequence
(cons `(/ ,(integer->char
@@ -3752,13 +3752,10 @@
matches)))
(if (not m)
(finish i acc)
- (let ((end (%irregex-match-end-index m 0)))
- (if (= end i)
- ;; skip one char forward if we match the empty string
- (lp (+ end 1) acc)
- (let ((acc (kons i m acc)))
- (irregex-reset-matches! matches)
- (lp end acc))))))))))
+ (let* ((end (%irregex-match-end-index m 0))
+ (acc (kons i m acc)))
+ (irregex-reset-matches! matches)
+ (lp end acc))))))))
(define (irregex-fold irx kons . args)
(if (not (procedure? kons)) (%irregex-error 'irregex-fold "not a procedure" kons))
@@ -3780,16 +3777,11 @@
(let ((m (irregex-search/matches irx cnk start i matches)))
(if (not m)
(finish start i acc)
- (let ((end-src (%irregex-match-end-chunk m 0))
- (end-index (%irregex-match-end-index m 0)))
- (if (and (eq? end-src start) (= end-index i))
- (if (>= end-index ((chunker-get-end cnk) end-src ))
- (let ((next ((chunker-get-next cnk) end-src)))
- (lp next ((chunker-get-start cnk) next) acc))
- (lp end-src (+ end-index 1) acc))
- (let ((acc (kons start i m acc)))
- (irregex-reset-matches! matches)
- (lp end-src end-index acc))))))))))
+ (let* ((acc (kons start i m acc))
+ (end-src (%irregex-match-end-chunk m 0))
+ (end-index (%irregex-match-end-index m 0)))
+ (irregex-reset-matches! matches)
+ (lp end-src end-index acc))))))))
(define (irregex-fold/chunked irx kons . args)
(if (not (procedure? kons)) (%irregex-error 'irregex-fold/chunked "not a procedure" kons))
diff --git a/manual/Types b/manual/Types
index 8a18448b..c180a3e7 100644
--- a/manual/Types
+++ b/manual/Types
@@ -56,7 +56,6 @@ Declares that the global variable {{IDENTIFIER}} is of the given type.
<syntax>(the TYPE EXPRESSION)</syntax>
-
Equivalent to {{EXPRESSION}}, but declares that the result will be of the
given type. Note that this form always declares the type of a single result,
{{the}} can not be used to declare types for multiple result values. {{TYPE}}
@@ -161,7 +160,7 @@ or {{:}} should follow the syntax given below:
Note that type-variables in {{forall}} types may be given "constraint" types, i.e.
- (: sort (forall (e (s (or (vector-of e) (list-of e))))
+ (: sort (forall (e (s (or (vector e) (list-of e))))
(s (e e -> *) -> s)))
declares that {{sort}} is a procedure of two arguments, the first
diff --git a/tests/test-irregex.scm b/tests/test-irregex.scm
index fd2cb97a..a06bc6bd 100644
--- a/tests/test-irregex.scm
+++ b/tests/test-irregex.scm
@@ -358,11 +358,6 @@
rope-chunker
(rope "bob@test.com and fred@example.com")
(lambda (src i s) (reverse s))))
- (test-equal '("poo poo ")
- (irregex-fold '(* "poo ")
- (lambda (i m s) (cons (irregex-match-substring m) s))
- '()
- "poo poo platter"))
)
@@ -504,13 +499,5 @@
(test-assert (not (irregex-search "(?u:<[あ-ん]*>)" "<ひらgがな>")))
(test-assert (not (irregex-search "(?u:<[^あ-ん語]*>)" "<語>")))
-(test-assert (irregex-search "(?u:<[^あ-ん]*>)" "<abc>"))
-(test-assert (not (irregex-search "(?u:<[^あ-ん]*>)" "<あん>")))
-(test-assert (not (irregex-search "(?u:<[^あ-ん]*>)" "<ひらがな>")))
-(test-assert (irregex-search "(?u:<[^あ-ん語]*>)" "<abc>"))
-(test-assert (not (irregex-search "(?u:<[^あ-ん語]*>)" "<あん>")))
-(test-assert (not (irregex-search "(?u:<[^あ-ん語]*>)" "<ひらがな>")))
-(test-assert (not (irregex-search "(?u:<[^あ-ん語]*>)" "<語>")))
-
-(test-end)
+(test-end)(test-exit)
diff --git a/types.db b/types.db
index 67013070..06ad8af5 100644
--- a/types.db
+++ b/types.db
@@ -1552,7 +1552,7 @@
(current-user-id (#(procedure #:clean) current-user-id () fixnum))
(current-user-name (#(procedure #:clean) current-user-name () string))
(delete-directory (#(procedure #:clean #:enforce) delete-directory (string) string))
-(directory (#(procedure #:clean #:enforce) directory (string #!optional *) (list-of string)))
+(directory (#(procedure #:clean #:enforce) directory (#!optional string *) (list-of string)))
(directory? (#(procedure #:clean #:enforce) directory? ((or string fixnum)) boolean))
(duplicate-fileno (#(procedure #:clean #:enforce) duplicate-fileno (fixnum #!optional fixnum) fixnum))
(errno/2big fixnum)
Trap