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 @@
"Use (f2cl-version) instead")
(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.
(defvar *f2cl2-version*)
......@@ -203,9 +203,11 @@ incorrect, so use caution.")
(defun relax-array-decl (decls)
(flet ((relax-1 (decl)
(cond ((and *relaxed-array-decls* (subtypep decl 'array))
(destructuring-bind (a n l)
(destructuring-bind (a &optional n l)
decl
`(,a ,n ,(mapcar (constantly '*) l))))
(if (subtypep a 'string)
`(a ,(mapcar (constantly '*) l))
`(,a ,n ,(mapcar (constantly '*) l)))))
(t
decl))))
(mapcar #'relax-1 decls)))
......@@ -1075,7 +1077,6 @@ correctly"
(if *common-block-file*
(do-file)
(do-output outport))))
(defun translate-and-write-subprog (prog-list outport output-path
declaim package options)
......@@ -1151,7 +1152,7 @@ correctly"
;; functions, in case the Fortran code has declared them as
;; external.
(setf fun (fixup-f2cl-lib fun (cons (cadr fort-fun) *external-function-names*)))
(special-print fun outport)
(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))
......@@ -3350,7 +3351,7 @@ loop2
;;;-----------------------------------------------------------------------------
;;; 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$
;;; Revision 1.222 2010/10/08 03:05:30 rtoy
;;; src/f2cl1.l:
......
......@@ -50,7 +50,7 @@
(in-package :f2cl)
(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
(eval-when (compile load eval)
......@@ -1439,13 +1439,16 @@
(cond ((and (listp decl)
(eq 'type (first decl))
(subtypep (second decl) 'array))
(destructuring-bind (a n l)
(destructuring-bind (a &optional n l)
(second decl)
`(type (,a ,n ,(mapcar #'(lambda (x)
(declare (ignore x))
'*)
l))
,@(rest (rest decl)))))
(if (subtypep a 'string)
`(type (,a *)
,@(rest (rest decl)))
`(type (,a ,n ,(mapcar #'(lambda (x)
(declare (ignore x))
'*)
l))
,@(rest (rest decl))))))
(t
decl)))
(first formal-arg-decls)))))
......@@ -2553,8 +2556,8 @@
;; scalar, no length spec.
;;(format t "scalar, no length spec = ~A~%" decl)
(if (equal (cadr type) '(*))
`(declare (type (simple-array character (*)) ,(car decl)))
`(declare (type (simple-array character (,(cadr type))) ,(car decl)))))
`(declare (type (simple-string) ,(car decl)))
`(declare (type (simple-string ,(cadr type)) ,(car decl)))))
((atom (cadr decl))
;; scalar, length spec.
;;(format t "scalar, length spec = ~A~%" decl)
......@@ -2564,16 +2567,16 @@
((equal (cadr decl) '(*))
;; unspecified length spec
;;(format t "unspecified length spec = ~A~%" decl)
`(declare (type (simple-array character (*)) ,(car decl))))
`(declare (type (simple-string) ,(car decl))))
(t
;; array, no length spec.
;;(format t "array, no length spec = ~A~%" decl)
;;(format t "type = ~S~%" type)
;;(format t "decl-bounds = ~S~%" (decl-bounds (rest decl)))
`(declare (type (,*array-type*
(simple-array character ,(if (second type)
`(,(second type))
'(*)))
(string ,(if (second type)
(second type)
'*))
,(decl-bounds (rest decl))) ,(car decl)))))))
(defun make-char-init (decl type &optional init)
......@@ -3858,7 +3861,7 @@
;;;-----------------------------------------------------------------------------
;;; 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$
;;; Revision 1.204 2010/02/23 05:21:30 rtoy
;;; 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