~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/lsp/predlib.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-06-21 09:21:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060621092121-txz1f21lj0wh0f67
Tags: 0.9h-20060617-1
* New upstream version
* Updated standards version without real changes. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
193
193
 
194
194
(dolist (l '((ARRAY . ARRAYP)
195
195
             (ATOM . ATOM)
 
196
             #-unicode
196
197
             (EXTENDED-CHAR . CONSTANTLY-NIL)
 
198
             #-unicode
197
199
             (BASE-CHAR . CHARACTERP)
 
200
             #+unicode
 
201
             (BASE-CHAR . BASE-CHAR-P)
198
202
             (CHARACTER . CHARACTERP)
199
203
             (COMPILED-FUNCTION . COMPILED-FUNCTION-P)
200
204
             (COMPLEX . COMPLEXP)
229
233
  (put-sysprop (car l) 'TYPE-PREDICATE (cdr l)))
230
234
 
231
235
(defconstant +upgraded-array-element-types+
232
 
  '(NIL BASE-CHAR BIT EXT::BYTE8 EXT::INTEGER8 EXT::CL-FIXNUM EXT::CL-INDEX SHORT-FLOAT LONG-FLOAT T))
 
236
  '(NIL BASE-CHAR CHARACTER BIT EXT::BYTE8 EXT::INTEGER8 EXT::CL-FIXNUM EXT::CL-INDEX SHORT-FLOAT LONG-FLOAT T))
233
237
 
234
238
(defun upgraded-array-element-type (element-type &optional env)
235
239
  (dolist (v +upgraded-array-element-types+ 'T)
341
345
    (STRING
342
346
     (and (stringp object)
343
347
          (or (null i) (match-dimensions object i))))
 
348
    #+unicode
 
349
    (BASE-STRING
 
350
     (and (stringp object)
 
351
          (typep (array-element-type object) 'base-char)
 
352
          (or (null i) (match-dimensions object i))))
344
353
    (BIT-VECTOR
345
354
     (and (bit-vector-p object)
346
355
          (or (null i) (match-dimensions object i))))
347
356
    (SIMPLE-STRING
348
357
     (and (simple-string-p object)
349
358
          (or (null i) (match-dimensions object i))))
 
359
    #+unicode
 
360
    (SIMPLE-BASE-STRING
 
361
     (and (simple-string-p object)
 
362
          (base-string-p object)
 
363
          (or (null i) (match-dimensions object i))))
350
364
    (SIMPLE-BIT-VECTOR
351
365
     (and (simple-bit-vector-p object)
352
366
          (or (null i) (match-dimensions object i))))
472
486
           ((DOUBLE-FLOAT LONG-FLOAT) (float object 0.0L0))
473
487
           (COMPLEX (complex (realpart object) (imagpart object)))
474
488
           (FUNCTION (coerce-to-function object))
475
 
           ((VECTOR SIMPLE-VECTOR SIMPLE-STRING STRING BIT-VECTOR SIMPLE-BIT-VECTOR)
 
489
           ((VECTOR SIMPLE-VECTOR #+unicode SIMPLE-BASE-STRING SIMPLE-STRING #+unicode BASE-STRING STRING BIT-VECTOR SIMPLE-BIT-VECTOR)
476
490
            (concatenate type object))
477
491
           (t
478
492
            (if (or (listp object) (vector object))
953
967
               (NUMBER (OR REAL COMPLEX))
954
968
 
955
969
               (CHARACTER)
 
970
               #-unicode
956
971
               (BASE-CHAR CHARACTER)
 
972
               #+unicode
 
973
               (BASE-CHAR NIL CHARACTER)
957
974
               (STANDARD-CHAR NIL BASE-CHAR)
958
975
 
959
976
               (CONS)
966
983
               (SIMPLE-BIT-VECTOR (SIMPLE-ARRAY BIT (*)))
967
984
               (VECTOR (ARRAY * (*)))
968
985
               (STRING (ARRAY CHARACTER (*)))
 
986
               #+unicode
 
987
               (BASE-STRING (ARRAY BASE-CHAR (*)))
969
988
               (SIMPLE-STRING (SIMPLE-ARRAY CHARACTER (*)))
 
989
               #+unicode
 
990
               (SIMPLE-BASE-STRING (SIMPLE-ARRAY BASE-CHAR (*)))
970
991
               (BIT-VECTOR (ARRAY BIT (*)))
971
992
 
972
993
               (SEQUENCE (OR CONS (MEMBER NIL) (ARRAY * (*))))