~ chicken-core (chicken-5) b2aaa204398f94b24308eff5312ad8b9b1a6c61a


commit b2aaa204398f94b24308eff5312ad8b9b1a6c61a
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Dec 23 12:35:09 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 23 12:35:09 2010 +0100

    removed deprecated left-section/right-section/noop/getenv and ftypes pointer/nonnull-pointer/byte-vector/nonnull-byte-vector

diff --git a/c-backend.scm b/c-backend.scm
index 7e35c7b7..3b49ede1 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -1169,12 +1169,8 @@
       [(unsigned-long) (str "unsigned long")]
       [(float) (str "float")]
       [(double number) (str "double")]
-      ;; pointer and nonnull-pointer are DEPRECATED
-      [(pointer nonnull-pointer) (str "void *")]
       [(c-pointer nonnull-c-pointer scheme-pointer nonnull-scheme-pointer) (str "void *")]
       [(c-string-list c-string-list*) "C_char **"]
-      ;; byte-vector and nonnull-byte-vector are DEPRECATED
-      [(byte-vector nonnull-byte-vector) (str "unsigned char *")]
       [(blob nonnull-blob u8vector nonnull-u8vector) (str "unsigned char *")]
       [(u16vector nonnull-u16vector) (str "unsigned short *")]
       [(s8vector nonnull-s8vector) (str "char *")]
@@ -1264,18 +1260,12 @@
       ((unsigned-integer64) "C_num_to_uint64(")
       ((long) "C_num_to_long(")
       ((unsigned-integer unsigned-integer32) "C_num_to_unsigned_int(")
-      ;; pointer and nonnull-pointer are DEPRECATED
-      ((pointer) "C_data_pointer_or_null(")
-      ((nonnull-pointer) "C_data_pointer(")
       ((scheme-pointer) "C_data_pointer_or_null(")
       ((nonnull-scheme-pointer) "C_data_pointer(")
       ((c-pointer) "C_c_pointer_or_null(")
       ((nonnull-c-pointer) "C_c_pointer_nn(")
       ((blob) "C_c_bytevector_or_null(")
       ((nonnull-blob) "C_c_bytevector(")
-      ;; byte-vector and nonnull-byte-vector are DEPRECATED
-      ((byte-vector) "C_c_bytevector_or_null(")
-      ((nonnull-byte-vector) "C_c_bytevector(")
       ((u8vector) "C_c_u8vector_or_null(")
       ((nonnull-u8vector) "C_c_u8vector(")
       ((u16vector) "C_c_u16vector_or_null(")
@@ -1304,9 +1294,6 @@
 		   (foreign-argument-conversion (if (vector? t) (vector-ref t 0) t)) ) ]
 	     [(and (list? type) (>= (length type) 2))
 	      (case (car type)
-	       ;; pointer and nonnull-pointer are DEPRECATED
-	       ((pointer) "C_c_pointer_or_null(")
-	       ((nonnull-pointer) "C_c_pointer_nn(")
 	       ((c-pointer) "C_c_pointer_or_null(")
 	       ((nonnull-c-pointer) "C_c_pointer_nn(")
 	       ((instance) "C_c_pointer_or_null(")
diff --git a/chicken.import.scm b/chicken.import.scm
index b32ef506..449465fc 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -152,7 +152,6 @@
    get-keyword
    get-output-string
    get-properties
-   getenv				; DEPRECATED
    getter-with-setter
    implicit-exit-handler
    keyword->string
diff --git a/csc.scm b/csc.scm
index 55c4c685..186a8301 100644
--- a/csc.scm
+++ b/csc.scm
@@ -145,11 +145,9 @@
   '(-debug -output-file -heap-size -nursery -stack-size -compiler -unit -uses -keyword-style
     -optimize-level -include-path -database-size -extend -prelude -postlude -prologue -epilogue 
     -inline-limit -profile-name
-    -disable-warning			; OBSOLETE
     -emit-inline-file -types
     -feature -debug-level -heap-growth -heap-shrinkage -heap-initial-size -consult-inline-file
     -emit-import-library
-    -static-extension 			; DEPRECATED
     -no-feature))
 
 (define-constant shortcuts
@@ -164,7 +162,6 @@
     (-i "-case-insensitive")
     (|-K| "-keyword-style")
     (|-X| "-extend")
-    (|-N| "-no-usual-integrations")	; DEPRECATED
     (|-J| "-emit-all-import-libraries")
     (-x "-explicit-use")
     (-u "-unsafe")
@@ -273,7 +270,6 @@
 (define shared #f)
 (define static #f)
 (define static-libs #f)
-(define static-extensions '())
 (define required-extensions '())
 
 
@@ -519,7 +515,7 @@ EOF
 	   (when inquiry-only
 	     (when show-cflags (print* (compiler-options) #\space))
 	     (when show-ldflags (print* (linker-options) #\space))
-	     (when show-libs (print* (linker-libraries #t) #\space))
+	     (when show-libs (print* (linker-libraries) #\space))
 	     (newline)
 	     (exit) )
 	   (cond [(null? scheme-files)
@@ -624,11 +620,6 @@ EOF
 		(set! required-extensions (append required-extensions (list (car rest))))
 		(t-options "-require-extension" (car rest))
 		(set! rest (cdr rest)) ]
-	       [(-static-extension)	;DEPRECATED
-		(check s rest)
-		(set! static-extensions (append static-extensions (list (car rest))))
-		(t-options "-static-extension" (car rest))
-		(set! rest (cdr rest)) ]
 	       ((-private-repository)
 		(use-private-repository))
 	       ((-no-elevation)
@@ -875,9 +866,7 @@ EOF
 ;;; Link object files and libraries:
 
 (define (run-linking)
-  (let* ((files (map quotewrap
-		     (append object-files
-			     (nth-value 0 (static-extension-info)) ) ) )
+  (let* ((files (map quotewrap object-files))
 	 (target (quotewrap target-filename))
 	 (targetdir #f))
     (when deploy
@@ -905,7 +894,7 @@ EOF
 	      files
 	      (list (string-append link-output-flag (quotewrap target-filename))
 		    (linker-options)
-		    (linker-libraries #f) ) ) ) ) )
+		    (linker-libraries) ) ) ) ) )
     (when (and osx (or (not cross-chicken) host-mode))
       (command
        (string-append
@@ -967,33 +956,15 @@ EOF
      (quotewrap from)
      (quotewrap to))))
 
-(define (static-extension-info)
-  (let ((rpath (repository-path)))
-    (if (and rpath (pair? static-extensions))
-	(let loop ((exts static-extensions) (libs '()) (opts '()))
-	  (if (null? exts)
-	      (values (reverse libs) (reverse opts))
-	      (let ((info (extension-information (car exts))))
-		(if info
-		    (let ((a (assq 'static info)) 
-			  (o (assq 'static-options info)) )
-		      (loop (cdr exts) 
-			(if a (cons (make-pathname rpath (cadr a)) libs) libs)
-			(if o (cons (cadr o) opts) opts) ) ) 
-		    (loop (cdr exts) libs opts)) ) ) )
-	(values '() '()) ) ) )
-
 (define (linker-options)
   (string-append
    (string-intersperse
-    (append linking-optimization-options link-options
-	    (nth-value 1 (static-extension-info)) ) )
+    (append linking-optimization-options link-options))
    (if (and static (not mingw) (not osx)) " -static" "") ) )
 
-(define (linker-libraries #!optional staticexts)
+(define (linker-libraries)
   (string-intersperse
    (append
-    (if staticexts (nth-value 0 (static-extension-info)) '())
     (if (or static static-libs)
         library-files
         shared-library-files)
diff --git a/data-structures.import.scm b/data-structures.import.scm
index 7ace4167..cfb7d3a3 100644
--- a/data-structures.import.scm
+++ b/data-structures.import.scm
@@ -48,7 +48,6 @@
    identity
    intersperse
    join
-   left-section				; DEPRECATED
    list->queue
    list-of?
    make-queue
@@ -56,7 +55,6 @@
    merge!
    never?
    none?
-   noop					;DEPRECATED
    o
    queue->list
    queue-add!
@@ -69,7 +67,6 @@
    queue?
    rassoc
    reverse-string-append
-   right-section			; DEPRECATED
    shuffle
    sort
    sort!
diff --git a/data-structures.scm b/data-structures.scm
index acb78afc..6a1b53c0 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -98,8 +98,6 @@ EOF
 	    [(pred (##sys#slot lst 0)) (loop (##sys#slot lst 1))]
 	    [else #f] ) ) ) )
 
-(define (noop . _) (void))		;DEPRECATED
-
 (define (each . procs)
   (cond ((null? procs) (lambda _ (void)))
 	((null? (##sys#slot procs 1)) (##sys#slot procs 0))
@@ -122,19 +120,6 @@ EOF
 
 (define (never? . _) #f)
 
-(define (left-section proc . args)	;DEPRECATED
-  (##sys#check-closure proc 'left-section)
-  (lambda xs
-    (##sys#apply proc (##sys#append args xs)) ) )
-
-(define right-section			;DEPRECATED
-  (let ([##sys#reverse reverse])
-    (lambda (proc . args)
-      (##sys#check-closure proc 'right-section)
-      (let ([revdargs (##sys#reverse args)])
-        (lambda xs
-          (##sys#apply proc (##sys#reverse (##sys#append revdargs (##sys#reverse xs)))) ) ) ) ) )
-
 
 ;;; List operators:
 
diff --git a/library.scm b/library.scm
index cb2223cb..c6874507 100644
--- a/library.scm
+++ b/library.scm
@@ -196,7 +196,6 @@ EOF
 (define (current-gc-milliseconds) (##sys#fudge 31))
 (define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
 (define get-environment-variable (##core#primitive "C_get_environment_variable"))
-(define getenv get-environment-variable) ; DEPRECATED
 
 (define (##sys#start-timer)
   (##sys#gc #t)
diff --git a/support.scm b/support.scm
index 2c0b425f..ae4be344 100644
--- a/support.scm
+++ b/support.scm
@@ -926,7 +926,7 @@
 	     [(int unsigned-int short unsigned-short byte unsigned-byte int32 unsigned-int32)
 	      (if unsafe param `(##sys#foreign-fixnum-argument ,param))]
 	     [(float double number) (if unsafe param `(##sys#foreign-flonum-argument ,param))]
-	     [(pointer byte-vector blob scheme-pointer) ; pointer and byte-vector are DEPRECATED
+	     [(blob scheme-pointer)
 	      (let ([tmp (gensym)])
 		`(let ([,tmp ,param])
 		   (if ,tmp
@@ -934,7 +934,7 @@
 			    tmp
 			    `(##sys#foreign-block-argument ,tmp) )
 		       '#f) ) ) ]
-	     [(nonnull-pointer nonnull-scheme-pointer nonnull-blob nonnull-byte-vector) ; nonnull-pointer and nonnull-byte-vector are DEPRECATED
+	     [(nonnull-scheme-pointer nonnull-blob)
 	      (if unsafe
 		  param
 		  `(##sys#foreign-block-argument ,param) ) ]
@@ -1090,10 +1090,10 @@
    (lambda (t next)
      (case t
        ((char int short bool unsigned-short unsigned-char unsigned-int long unsigned-long byte unsigned-byte
-	      c-pointer pointer nonnull-c-pointer unsigned-integer integer float c-string symbol
+	      c-pointer nonnull-c-pointer unsigned-integer integer float c-string symbol
 	      scheme-pointer nonnull-scheme-pointer int32 unsigned-int32 integer32 unsigned-integer32
               unsigned-c-string unsigned-c-string* nonnull-unsigned-c-string* size_t
-	      nonnull-c-string c-string* nonnull-c-string* c-string-list c-string-list*) ; pointer and nonnull-pointer are DEPRECATED
+	      nonnull-c-string c-string* nonnull-c-string* c-string-list c-string-list*)
 	(words->bytes 1) )
        ((double number integer64 unsigned-integer64)
 	(words->bytes 2) )
Trap