~ chicken-core (chicken-5) 9e73b5a89fbbf5067b577869cd7709306fc0772f

commit 9e73b5a89fbbf5067b577869cd7709306fc0772f
Merge: 5defd64d 7893f6eb
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jul 12 21:45:42 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jul 12 21:45:42 2011 +0200

    resolved conflicts

diff --cc types.db
index 10103abc,8aca3a10..0db14df9
--- a/types.db
+++ b/types.db
@@@ -764,35 -375,26 +764,35 @@@
  (minimum-flonum float)
  (most-negative-fixnum fixnum)
  (most-positive-fixnum fixnum)
 -(on-exit (procedure on-exit ((procedure () . *)) undefined))
 -(open-input-string (procedure open-input-string (string #!rest) port))
 +(on-exit (procedure! on-exit ((procedure () . *)) undefined))
 +(open-input-string (procedure! open-input-string (string #!rest) port))
  (open-output-string (procedure open-output-string (#!rest) port))
  (parentheses-synonyms (procedure parentheses-synonyms (#!optional *) *))
 -(port-name (procedure port-name (#!optional port) *))
 -(port-position (procedure port-position (#!optional port) fixnum))
 -(port? (procedure port? (*) boolean))
 +
 +(port-name (procedure! port-name (#!optional port) *)
 +	   ((port) (##sys#slot #(1) '3)))
 +
 +(port-position (procedure! port-position (#!optional port) fixnum))
 +
 +(port? (procedure? port port? (*) boolean))
 +
  (print (procedure print (#!rest *) undefined))
 -(print-call-chain (procedure print-call-chain (#!optional port fixnum * string) undefined))
 -(print-error-message (procedure print-error-message (* #!optional port string) undefined))
 +(print-call-chain (procedure! print-call-chain (#!optional port fixnum * string) undefined))
 +(print-error-message (procedure! print-error-message (* #!optional port string) undefined))
  (print* (procedure print* (#!rest) undefined))
 -(procedure-information (procedure procedure-information (procedure) *))
 -(program-name (procedure program-name (#!optional string) string))
 +(procedure-information (procedure! procedure-information (procedure) *))
 +(program-name (procedure! program-name (#!optional string) string))
  (promise? (procedure promise? (*) boolean))
 -(put! (procedure put! (symbol symbol *) undefined))
 -(register-feature! (procedure register-feature! (#!rest symbol) undefined))
 -(remprop! (procedure remprop! (symbol symbol) undefined))
 -(rename-file (procedure rename-file (string string) string))
 -(repl (procedure repl (#!optional (procedure (*) *)) undefined))
 -(repl-prompt (procedure repl-prompt (#!optional procedure) procedure))
 +
 +(put! (procedure! put! (symbol symbol *) undefined)
 +      ((symbol symbol *)
 +       (##core#inline_allocate ("C_a_i_putprop" 8) #(1) #(2) #(3))))
 +
 +(register-feature! (procedure! register-feature! (#!rest symbol) undefined))
 +(remprop! (procedure! remprop! (symbol symbol) undefined))
 +(rename-file (procedure! rename-file (string string) string))
- (repl (procedure repl () undefined))
++(repl (procedure! repl (#!optional (procedure (*) *)) undefined))
 +(repl-prompt (procedure! repl-prompt (#!optional procedure) procedure))
  (repository-path (procedure repository-path (#!optional *) *))
  (require (procedure require (#!rest *) undefined))
  (reset (procedure reset () undefined))
@@@ -893,89 -430,68 +893,89 @@@
  
  ;; data-structures
  
 -(->string (procedure ->string (*) string))
 -(alist-ref (procedure alist-ref (* list #!optional (procedure (* *) *) *) *))
 -(alist-update! (procedure alist-update! (* * list #!optional (procedure (* *) *)) *))
 +(->string (procedure ->string (*) string)
 +	  ((string) #(1)))
 +
 +(alist-ref (procedure! alist-ref (* list #!optional (procedure (* *) *) *) *))
 +(alist-update! (procedure! alist-update! (* * list #!optional (procedure (* *) *)) *))
  (always? (procedure always? (#!rest) boolean))
 -(any? (procedure any? (*) boolean))
 -(atom? (procedure atom? (*) boolean))
 -(binary-search (procedure binary-search (vector (procedure (*) *)) *))
 -(butlast (procedure butlast (pair) list))
 -(chop (procedure chop (list fixnum) list))
 -(complement (procedure complement (procedure) procedure))
 -(compose (procedure compose (#!rest procedure) procedure))
 -(compress (procedure compress (list list) list))
 +
 +(any? (procedure any? (*) boolean)
 +      ((*) (let ((#(tmp) #(1))) '#t)))
 +
 +(atom? (procedure atom? (*) boolean)
 +       ((pair) (let ((#(tmp) #(1))) '#f))
 +       (((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
 +
 +(binary-search (procedure! binary-search (vector (procedure (*) *)) *))
 +(butlast (procedure! butlast (pair) list))
 +(chop (procedure! chop (list fixnum) list))
 +(complement (procedure! complement (procedure) procedure))
 +(compose (procedure! compose (#!rest procedure) procedure))
 +(compress (procedure! compress (list list) list))
  (conc (procedure conc (#!rest) string))
 -(conjoin (procedure conjoin (#!rest (procedure (*) *)) (procedure (*) *)))
 +(conjoin (procedure! conjoin (#!rest (procedure (*) *)) (procedure (*) *)))
  (constantly (procedure constantly (#!rest) . *))
 -(disjoin (procedure disjoin (#!rest (procedure (*) *)) (procedure (*) *)))
 -(each (procedure each (#!rest procedure) procedure))
 -(flatten (procedure flatten (pair) list))
 -(flip (procedure flip ((procedure (* *) . *)) procedure))
 +(disjoin (procedure! disjoin (#!rest (procedure (*) *)) (procedure (*) *)))
 +(each (procedure! each (#!rest procedure) procedure))
 +(flatten (procedure! flatten (pair) list))
 +(flip (procedure! flip ((procedure (* *) . *)) procedure))
  (identity (procedure identity (*) *))
 -(intersperse (procedure intersperse (list *) list))
 -(join (procedure join (list list) list))
 -(left-section deprecated)
 -(list->queue (procedure list->queue (list) (struct queue)))
 -(list-of? (procedure list-of? ((procedure (*) *)) (procedure (list) boolean)))
 +(intersperse (procedure! intersperse (list *) list))
 +(join (procedure! join (list list) list))
 +(list->queue (procedure! list->queue (list) (struct queue)))
 +(list-of? (procedure! list-of? ((procedure (*) *)) (procedure (list) boolean)))
  (make-queue (procedure make-queue () (struct queue)))
 -(merge (procedure merge (list list (procedure (* *) *)) list))
 -(merge! (procedure merge! (list list (procedure (* *) *)) list))
 +(merge (procedure! merge (list list (procedure (* *) *)) list))
 +(merge! (procedure! merge! (list list (procedure (* *) *)) list))
  (never? (procedure never? (#!rest) boolean))
 -(none? (procedure none? (*) boolean))
 -(noop (deprecated void))
 -(o (procedure o (#!rest (procedure (*) *)) (procedure (*) *)))
 -(project (procedure project (fixnum) procedure))
 -(queue->list (procedure queue->list ((struct queue)) list))
 -(queue-add! (procedure queue-add! ((struct queue) *) undefined))
 -(queue-empty? (procedure queue-empty? ((struct queue)) boolean))
 -(queue-first (procedure queue-first ((struct queue)) *))
 -(queue-last (procedure queue-last ((struct queue)) *))
 -(queue-push-back! (procedure queue-push-back! ((struct queue) *) undefined))
 -(queue-push-back-list! (procedure queue-push-back-list! ((struct queue) list) undefined))
 -(queue-remove! (procedure queue-remove! ((struct queue)) *))
 -(queue? (procedure queue? (*) boolean))
 -(rassoc (procedure rassoc (* list #!optional (procedure (* *) *)) *))
 -(right-section deprecated)
 -(reverse-string-append (procedure reverse-string-append (list) string))
 +
 +(none? (procedure none? (*) boolean)
 +       ((*) (let ((#(tmp) #(1))) '#f)))
 +
 +(o (procedure! o (#!rest (procedure (*) *)) (procedure (*) *)))
 +
 +(queue->list (procedure! queue->list ((struct queue)) list)
 +	     (((struct queue)) (##sys#slot #(1) '1)))
 +
 +(queue-add! (procedure! queue-add! ((struct queue) *) undefined))
 +
 +(queue-empty? (procedure! queue-empty? ((struct queue)) boolean)
 +	      (((struct queue)) (##core#inline "C_i_nullp" (##sys#slot #(1) '1))))
 +
 +(queue-first (procedure! queue-first ((struct queue)) *))
 +(queue-last (procedure! queue-last ((struct queue)) *))
 +(queue-push-back! (procedure! queue-push-back! ((struct queue) *) undefined))
 +(queue-push-back-list! (procedure! queue-push-back-list! ((struct queue) list) undefined))
 +(queue-remove! (procedure! queue-remove! ((struct queue)) *))
 +(queue? (procedure? (struct queue) queue? (*) boolean))
 +
 +(rassoc (procedure! rassoc (* list #!optional (procedure (* *) *)) *))
 +(reverse-string-append (procedure! reverse-string-append (list) string))
- (shuffle (procedure! shuffle (list (procedure (fixnum) fixnum)) list))
+ (shuffle deprecated)
 -(sort (procedure sort ((or list vector) (procedure (* *) *)) (or list vector)))
 -(sort! (procedure sort! ((or list vector) (procedure (* *) *)) (or list vector)))
 -(sorted? (procedure sorted? ((or list vector) (procedure (* *) *)) boolean))
 -(topological-sort (procedure topological-sort (list (procedure (* *) *)) list))
 -(string-chomp (procedure string-chomp (string #!optional string) string))
 -(string-chop (procedure string-chop (string fixnum) list))
 -(string-compare3 (procedure string-compare3 (string string) fixnum))
 -(string-compare3-ci (procedure string-compare3-ci (string string) fixnum))
 -(string-intersperse (procedure string-intersperse (list #!optional string) string))
 -(string-split (procedure string-split (string #!optional string *) list))
 -(string-translate (procedure string-translate (string * #!optional *) string))
 -(string-translate* (procedure string-translate* (string list) string))
 -(substring-ci=? (procedure substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean))
 -(substring-index (procedure substring-index (string string #!optional fixnum) *))
 -(substring-index-ci (procedure substring-index-ci (string string #!optional fixnum) *))
 -(substring=? (procedure substring=? (string string #!optional fixnum fixnum fixnum) boolean))
 +(sort (procedure! sort ((or list vector) (procedure (* *) *)) (or list vector)))
 +(sort! (procedure! sort! ((or list vector) (procedure (* *) *)) (or list vector)))
 +(sorted? (procedure! sorted? ((or list vector) (procedure (* *) *)) boolean))
 +(topological-sort (procedure! topological-sort (list (procedure (* *) *)) list))
 +(string-chomp (procedure! string-chomp (string #!optional string) string))
 +(string-chop (procedure! string-chop (string fixnum) list))
 +(string-compare3 (procedure! string-compare3 (string string) fixnum))
 +(string-compare3-ci (procedure! string-compare3-ci (string string) fixnum))
 +(string-intersperse (procedure! string-intersperse (list #!optional string) string))
 +(string-split (procedure! string-split (string #!optional string *) list))
 +(string-translate (procedure! string-translate (string * #!optional *) string))
 +(string-translate* (procedure! string-translate* (string list) string))
 +(substring-ci=? (procedure! substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean))
 +
 +(substring-index (procedure! substring-index (string string #!optional fixnum) *)
 +		 ((* *) (##sys#substring-index #(1) #(2) '0))
 +		 ((* * *) (##sys#substring-index #(1) #(2) #(3))))
 +
 +(substring-index-ci (procedure! substring-index-ci (string string #!optional fixnum) *)
 +		    ((* *) (##sys#substring-index-ci #(1) #(2) '0))
 +		    ((* * *) (##sys#substring-index-ci #(1) #(2) #(3))))
 +
 +(substring=? (procedure! substring=? (string string #!optional fixnum fixnum fixnum) boolean))
  (tail? (procedure tail? (* *) boolean))
  
  ;; extras