diff options
Diffstat (limited to 'module/ice-9/boot-9.scm')
-rw-r--r-- | module/ice-9/boot-9.scm | 82 |
1 files changed, 13 insertions, 69 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 469f279c0..5443b2fb6 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -849,30 +849,6 @@ VALUE." -;;; {Symbol Properties} -;;; - -;;; Symbol properties are something you see in old Lisp code. In most current -;;; Guile code, symbols are not used as a data structure -- they are used as -;;; keys into other data structures. - -(define (symbol-property sym prop) - (let ((pair (assoc prop (symbol-pref sym)))) - (and pair (cdr pair)))) - -(define (set-symbol-property! sym prop val) - (let ((pair (assoc prop (symbol-pref sym)))) - (if pair - (set-cdr! pair val) - (symbol-pset! sym (acons prop val (symbol-pref sym)))))) - -(define (symbol-property-remove! sym prop) - (let ((pair (assoc prop (symbol-pref sym)))) - (if pair - (symbol-pset! sym (delq! pair (symbol-pref sym)))))) - - - ;;; {Arrays} ;;; @@ -1009,6 +985,9 @@ See also: @code{array-dimensions}, @code{array-rank}." (define* (make-record-type type-name fields #:optional printer #:key parent uid extensible? allow-duplicate-field-names? (opaque? (and=> parent record-type-opaque?))) + (unless (symbol? type-name) + (error "expected a symbol for record type name" type-name)) + ;; Pre-generate constructors for nfields < 20. (define-syntax make-constructor (lambda (x) @@ -1127,17 +1106,6 @@ See also: @code{array-dimensions}, @code{array-rank}." (logior mutable (ash 1 i)) mutable)))))) - (define name-sym - (cond - ((symbol? type-name) type-name) - ((string? type-name) - (issue-deprecation-warning - "Passing a string as a type-name to make-record-type is deprecated." - " Pass a symbol instead.") - (string->symbol type-name)) - (else - (error "expected a symbol for record type name" type-name)))) - (define properties (let ((maybe-acons (lambda (k v tail) (if v (acons k v tail) tail)))) @@ -1149,7 +1117,7 @@ See also: @code{array-dimensions}, @code{array-rank}." (cond ((and uid (hashq-ref prefab-record-types uid)) => (lambda (rtd) - (unless (and (equal? (record-type-name rtd) name-sym) + (unless (and (equal? (record-type-name rtd) type-name) (equal? (record-type-fields rtd) computed-fields) (not printer) (equal? (record-type-properties rtd) properties) @@ -1165,7 +1133,7 @@ See also: @code{array-dimensions}, @code{array-rank}." (apply string-append (map (lambda (f) "pw") computed-fields))) (or printer default-record-printer) - name-sym + type-name computed-fields #f ; Constructor initialized below. properties @@ -1178,7 +1146,7 @@ See also: @code{array-dimensions}, @code{array-rank}." ;; Temporary solution: Associate a name to the record type ;; descriptor so that the object system can create a wrapper ;; class for it. - (set-struct-vtable-name! rtd name-sym) + (set-struct-vtable-name! rtd type-name) (when uid (unless (symbol? uid) @@ -1187,24 +1155,7 @@ See also: @code{array-dimensions}, @code{array-rank}." rtd)))) -(define record-constructor - (case-lambda - ((rtd) - (record-type-constructor rtd)) - ((rtd field-names) - (issue-deprecation-warning - "Calling `record-constructor' with two arguments (the record type" - " and a list of field names) is deprecated. Instead, call with just" - " one argument, and provide a wrapper around that constructor if" - " needed.") - (primitive-eval - `(lambda ,field-names - (make-struct/no-tail ',rtd - ,@(map (lambda (f) - (if (memq f field-names) - f - #f)) - (record-type-fields rtd)))))))) +(define record-constructor record-type-constructor) (define (record-predicate rtd) (unless (record-type? rtd) @@ -2551,12 +2502,8 @@ name extensions listed in %load-extensions." (define* (make-module #:optional (size 0) (uses '()) (binder #f)) "Create a new module, perhaps with a particular size of obarray, initial uses list, or binding procedure." - (unless (integer? size) - (error "Illegal size to make-module." size)) - (unless (zero? size) - (issue-deprecation-warning - "Passing a non-zero size argument to `make-module' is deprecated. " - "Omit the argument or pass zero instead.")) + (unless (eq? size 0) + (error "Invalid size to make-module." size)) (unless (and (list? uses) (and-map module? uses)) (error "Incorrect use list." uses)) (when (and binder (not (procedure? binder))) @@ -3289,9 +3236,6 @@ deterministic." (make-modules-in root name))))))))))) -(define (try-load-module name version) - (try-module-autoload name version)) - (define (reload-module m) "Revisit the source file corresponding to the module @var{m}." (let ((f (module-filename m))) @@ -3543,10 +3487,7 @@ module '(ice-9 q) '(make-q q-length))}." (define autoloads-in-progress '()) -;; This function is called from scm_load_scheme_module in -;; "deprecated.c". Please do not change its interface. -;; -(define* (try-module-autoload module-name #:optional version) +(define* (try-load-module module-name #:optional version) "Try to load a module of the given name. If it is not found, return #f. Otherwise return #t. May raise an exception if a file is found, but it fails to load." @@ -4735,6 +4676,9 @@ R7RS." ;;; (define (make-soft-port pv modes) + (issue-deprecation-warning + "make-soft-port in the default environment is deprecated. Import " + "(ice-9 soft-ports) instead, which has a better interface.") ((module-ref (resolve-interface '(ice-9 soft-ports)) 'deprecated-make-soft-port) pv modes)) |