~ 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