Changeset 1140:46c1f6a93b0d

Show
Ignore:
Timestamp:
05/02/12 21:40:28 (2 years ago)
Author:
Raymond Toy <toy.raymond@…>
Branch:
default
Message:

Don't declare strings as (simple-array character). In general that's
incorrect for literal strings because they can be base-strings or
strings, depending on the implementation. (Ecl does this).

Thus, just declare them as simple-strings which includes all string
types.

Location:
src
Files:
2 modified

Legend:

Unmodified
Added
Removed
  • src/f2cl1.l

    r1135 r1140  
    204204  (flet ((relax-1 (decl) 
    205205           (cond ((and *relaxed-array-decls* (subtypep decl 'array)) 
    206                   (destructuring-bind (a n l) 
     206                  (destructuring-bind (a &optional n l) 
    207207                      decl 
    208                     `(,a ,n ,(mapcar (constantly '*) l)))) 
     208                    (if (subtypep a 'string) 
     209                        `(a ,(mapcar (constantly '*) l)) 
     210                        `(,a ,n ,(mapcar (constantly '*) l))))) 
    209211                 (t 
    210212                  decl)))) 
     
    10761078        (do-file) 
    10771079        (do-output outport)))) 
    1078      
    10791080 
    10801081(defun translate-and-write-subprog (prog-list outport output-path 
     
    11521153       ;; external. 
    11531154       (setf fun (fixup-f2cl-lib fun (cons (cadr fort-fun) *external-function-names*))) 
    1154         
     1155 
    11551156       (special-print fun outport) 
    11561157       (format outport "~2&(in-package #-gcl #:cl-user #+gcl \"CL-USER\")~%#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))~%") 
  • src/f2cl5.l

    r1135 r1140  
    14401440                                      (eq 'type (first decl)) 
    14411441                                      (subtypep (second decl) 'array)) 
    1442                                  (destructuring-bind (a n l) 
     1442                                 (destructuring-bind (a &optional n l) 
    14431443                                     (second decl) 
    1444                                    `(type (,a ,n ,(mapcar #'(lambda (x) 
    1445                                                               (declare (ignore x)) 
    1446                                                               '*) 
    1447                                                           l)) 
    1448                                      ,@(rest (rest decl))))) 
     1444                                   (if (subtypep a 'string) 
     1445                                       `(type (,a *) 
     1446                                              ,@(rest (rest decl))) 
     1447                                       `(type (,a ,n ,(mapcar #'(lambda (x) 
     1448                                                                  (declare (ignore x)) 
     1449                                                                  '*) 
     1450                                                              l)) 
     1451                                              ,@(rest (rest decl)))))) 
    14491452                                (t 
    14501453                                 decl))) 
     
    25542557           ;;(format t "scalar, no length spec = ~A~%" decl) 
    25552558           (if (equal (cadr type) '(*)) 
    2556                `(declare (type (simple-array character (*)) ,(car decl)))     
    2557                `(declare (type (simple-array character (,(cadr type))) ,(car decl))))) 
     2559               `(declare (type (simple-string) ,(car decl)))     
     2560               `(declare (type (simple-string ,(cadr type)) ,(car decl))))) 
    25582561          ((atom (cadr decl)) 
    25592562           ;; scalar, length spec. 
     
    25652568           ;; unspecified length spec 
    25662569           ;;(format t "unspecified length spec = ~A~%" decl) 
    2567            `(declare (type (simple-array character (*)) ,(car decl)))) 
     2570           `(declare (type (simple-string) ,(car decl)))) 
    25682571          (t 
    25692572           ;; array, no length spec. 
     
    25722575           ;;(format t "decl-bounds = ~S~%" (decl-bounds (rest decl))) 
    25732576           `(declare (type (,*array-type* 
    2574                             (simple-array character ,(if (second type) 
    2575                                                          `(,(second type)) 
    2576                                                          '(*))) 
     2577                            (string ,(if (second type) 
     2578                                                         (second type) 
     2579                                                         '*)) 
    25772580                            ,(decl-bounds (rest decl))) ,(car decl))))))) 
    25782581