Commit aa6e6d0a authored by Raymond Toy's avatar Raymond Toy

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.
parent cbc0d092
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
"Use (f2cl-version) instead") "Use (f2cl-version) instead")
(defparameter *f2cl1-version* (defparameter *f2cl1-version*
"$Id: f2cl1.l,v 2bc8b118fd29 2011/12/03 06:01:32 toy $") "$Id: f2cl1.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $")
;; Forward declarations. ;; Forward declarations.
(defvar *f2cl2-version*) (defvar *f2cl2-version*)
...@@ -203,9 +203,11 @@ incorrect, so use caution.") ...@@ -203,9 +203,11 @@ incorrect, so use caution.")
(defun relax-array-decl (decls) (defun relax-array-decl (decls)
(flet ((relax-1 (decl) (flet ((relax-1 (decl)
(cond ((and *relaxed-array-decls* (subtypep decl 'array)) (cond ((and *relaxed-array-decls* (subtypep decl 'array))
(destructuring-bind (a n l) (destructuring-bind (a &optional n l)
decl decl
`(,a ,n ,(mapcar (constantly '*) l)))) (if (subtypep a 'string)
`(a ,(mapcar (constantly '*) l))
`(,a ,n ,(mapcar (constantly '*) l)))))
(t (t
decl)))) decl))))
(mapcar #'relax-1 decls))) (mapcar #'relax-1 decls)))
...@@ -1075,7 +1077,6 @@ correctly" ...@@ -1075,7 +1077,6 @@ correctly"
(if *common-block-file* (if *common-block-file*
(do-file) (do-file)
(do-output outport)))) (do-output outport))))
(defun translate-and-write-subprog (prog-list outport output-path (defun translate-and-write-subprog (prog-list outport output-path
declaim package options) declaim package options)
...@@ -1151,7 +1152,7 @@ correctly" ...@@ -1151,7 +1152,7 @@ correctly"
;; functions, in case the Fortran code has declared them as ;; functions, in case the Fortran code has declared them as
;; external. ;; external.
(setf fun (fixup-f2cl-lib fun (cons (cadr fort-fun) *external-function-names*))) (setf fun (fixup-f2cl-lib fun (cons (cadr fort-fun) *external-function-names*)))
(special-print fun outport) (special-print fun outport)
(format outport "~2&(in-package #-gcl #:cl-user #+gcl \"CL-USER\")~%#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))~%") (format outport "~2&(in-package #-gcl #:cl-user #+gcl \"CL-USER\")~%#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))~%")
(let* ((*package* (find-package '#:cl-user)) (let* ((*package* (find-package '#:cl-user))
...@@ -3350,7 +3351,7 @@ loop2 ...@@ -3350,7 +3351,7 @@ loop2
;;;----------------------------------------------------------------------------- ;;;-----------------------------------------------------------------------------
;;; end of f2cl1.l ;;; end of f2cl1.l
;;; ;;;
;;; $Id: f2cl1.l,v 2bc8b118fd29 2011/12/03 06:01:32 toy $ ;;; $Id: f2cl1.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $
;;; $Log$ ;;; $Log$
;;; Revision 1.222 2010/10/08 03:05:30 rtoy ;;; Revision 1.222 2010/10/08 03:05:30 rtoy
;;; src/f2cl1.l: ;;; src/f2cl1.l:
......
...@@ -50,7 +50,7 @@ ...@@ -50,7 +50,7 @@
(in-package :f2cl) (in-package :f2cl)
(defparameter *f2cl5-version* (defparameter *f2cl5-version*
"$Id: f2cl5.l,v 2bc8b118fd29 2011/12/03 06:01:32 toy $") "$Id: f2cl5.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $")
;; functions for setting up varaible declarations and initialisations ;; functions for setting up varaible declarations and initialisations
(eval-when (compile load eval) (eval-when (compile load eval)
...@@ -1439,13 +1439,16 @@ ...@@ -1439,13 +1439,16 @@
(cond ((and (listp decl) (cond ((and (listp decl)
(eq 'type (first decl)) (eq 'type (first decl))
(subtypep (second decl) 'array)) (subtypep (second decl) 'array))
(destructuring-bind (a n l) (destructuring-bind (a &optional n l)
(second decl) (second decl)
`(type (,a ,n ,(mapcar #'(lambda (x) (if (subtypep a 'string)
(declare (ignore x)) `(type (,a *)
'*) ,@(rest (rest decl)))
l)) `(type (,a ,n ,(mapcar #'(lambda (x)
,@(rest (rest decl))))) (declare (ignore x))
'*)
l))
,@(rest (rest decl))))))
(t (t
decl))) decl)))
(first formal-arg-decls))))) (first formal-arg-decls)))))
...@@ -2553,8 +2556,8 @@ ...@@ -2553,8 +2556,8 @@
;; scalar, no length spec. ;; scalar, no length spec.
;;(format t "scalar, no length spec = ~A~%" decl) ;;(format t "scalar, no length spec = ~A~%" decl)
(if (equal (cadr type) '(*)) (if (equal (cadr type) '(*))
`(declare (type (simple-array character (*)) ,(car decl))) `(declare (type (simple-string) ,(car decl)))
`(declare (type (simple-array character (,(cadr type))) ,(car decl))))) `(declare (type (simple-string ,(cadr type)) ,(car decl)))))
((atom (cadr decl)) ((atom (cadr decl))
;; scalar, length spec. ;; scalar, length spec.
;;(format t "scalar, length spec = ~A~%" decl) ;;(format t "scalar, length spec = ~A~%" decl)
...@@ -2564,16 +2567,16 @@ ...@@ -2564,16 +2567,16 @@
((equal (cadr decl) '(*)) ((equal (cadr decl) '(*))
;; unspecified length spec ;; unspecified length spec
;;(format t "unspecified length spec = ~A~%" decl) ;;(format t "unspecified length spec = ~A~%" decl)
`(declare (type (simple-array character (*)) ,(car decl)))) `(declare (type (simple-string) ,(car decl))))
(t (t
;; array, no length spec. ;; array, no length spec.
;;(format t "array, no length spec = ~A~%" decl) ;;(format t "array, no length spec = ~A~%" decl)
;;(format t "type = ~S~%" type) ;;(format t "type = ~S~%" type)
;;(format t "decl-bounds = ~S~%" (decl-bounds (rest decl))) ;;(format t "decl-bounds = ~S~%" (decl-bounds (rest decl)))
`(declare (type (,*array-type* `(declare (type (,*array-type*
(simple-array character ,(if (second type) (string ,(if (second type)
`(,(second type)) (second type)
'(*))) '*))
,(decl-bounds (rest decl))) ,(car decl))))))) ,(decl-bounds (rest decl))) ,(car decl)))))))
(defun make-char-init (decl type &optional init) (defun make-char-init (decl type &optional init)
...@@ -3858,7 +3861,7 @@ ...@@ -3858,7 +3861,7 @@
;;;----------------------------------------------------------------------------- ;;;-----------------------------------------------------------------------------
;;; end of f2cl5.l ;;; end of f2cl5.l
;;; ;;;
;;; $Id: f2cl5.l,v 2bc8b118fd29 2011/12/03 06:01:32 toy $ ;;; $Id: f2cl5.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $
;;; $Log$ ;;; $Log$
;;; Revision 1.204 2010/02/23 05:21:30 rtoy ;;; Revision 1.204 2010/02/23 05:21:30 rtoy
;;; Fix declaration for default integer type. Previously the type was ;;; Fix declaration for default integer type. Previously the type was
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment