Changeset 1140:46c1f6a93b0d


Ignore:
Timestamp:
05/03/12 04: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 edited

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  
    14421442                                      (eq 'type (first decl))
    14431443                                      (subtypep (second decl) 'array))
    1444                                  (destructuring-bind (a n l)
     1444                                 (destructuring-bind (a &optional n l)
    14451445                                     (second decl)
    1446                                    `(type (,a ,n ,(mapcar #'(lambda (x)
    1447                                                               (declare (ignore x))
    1448                                                               '*)
    1449                                                           l))
    1450                                      ,@(rest (rest decl)))))
     1446                                   (if (subtypep a 'string)
     1447                                       `(type (,a *)
     1448                                              ,@(rest (rest decl)))
     1449                                       `(type (,a ,n ,(mapcar #'(lambda (x)
     1450                                                                  (declare (ignore x))
     1451                                                                  '*)
     1452                                                              l))
     1453                                              ,@(rest (rest decl))))))
    14511454                                (t
    14521455                                 decl)))
     
    25562559           ;;(format t "scalar, no length spec = ~A~%" decl)
    25572560           (if (equal (cadr type) '(*))
    2558                `(declare (type (simple-array character (*)) ,(car decl)))   
    2559                `(declare (type (simple-array character (,(cadr type))) ,(car decl)))))
     2561               `(declare (type (simple-string) ,(car decl)))   
     2562               `(declare (type (simple-string ,(cadr type)) ,(car decl)))))
    25602563          ((atom (cadr decl))
    25612564           ;; scalar, length spec.
     
    25672570           ;; unspecified length spec
    25682571           ;;(format t "unspecified length spec = ~A~%" decl)
    2569            `(declare (type (simple-array character (*)) ,(car decl))))
     2572           `(declare (type (simple-string) ,(car decl))))
    25702573          (t
    25712574           ;; array, no length spec.
     
    25742577           ;;(format t "decl-bounds = ~S~%" (decl-bounds (rest decl)))
    25752578           `(declare (type (,*array-type*
    2576                             (simple-array character ,(if (second type)
    2577                                                          `(,(second type))
    2578                                                          '(*)))
     2579                            (string ,(if (second type)
     2580                                                         (second type)
     2581                                                         '*))
    25792582                            ,(decl-bounds (rest decl))) ,(car decl)))))))
    25802583
Note: See TracChangeset for help on using the changeset viewer.