Commit 7cb602dc authored by Raymond Toy's avatar Raymond Toy

Fix up some bugs in the last fix for using STRING declarations instead of

(SIMPLE-ARRAY CHARACTER).

src/f2cl1.l:
o Fix typo in RELAX-ARRAY-DECL.

src/f2cl5.l:
o Need to handle the new STRING declarations correctly in
  GENERATE-WITH-ARRAY.

src/macros.l:
o In MULTI-ARRAY-DATA-AUX, handle arrays of type CHARACTER specially.
  Make the declaration STRING instead of (SIMPLE-ARRAY CHARACTER).
parent aa6e6d0a
......@@ -17,7 +17,7 @@
"Use (f2cl-version) instead")
(defparameter *f2cl1-version*
"$Id: f2cl1.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $")
"$Id: f2cl1.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $")
;; Forward declarations.
(defvar *f2cl2-version*)
......@@ -206,7 +206,7 @@ incorrect, so use caution.")
(destructuring-bind (a &optional n l)
decl
(if (subtypep a 'string)
`(a ,(mapcar (constantly '*) l))
`(,a ,@(mapcar (constantly '*) l))
`(,a ,n ,(mapcar (constantly '*) l)))))
(t
decl))))
......@@ -3351,7 +3351,7 @@ loop2
;;;-----------------------------------------------------------------------------
;;; end of f2cl1.l
;;;
;;; $Id: f2cl1.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $
;;; $Id: f2cl1.l,v 3fe93de3be82 2012/05/06 02:17:14 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 46c1f6a93b0d 2012/05/03 04:40:28 toy $")
"$Id: f2cl5.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $")
;; functions for setting up varaible declarations and initialisations
(eval-when (compile load eval)
......@@ -2027,8 +2027,12 @@
(flet ((find-type (a)
(dolist (x (rest (first formal-arg-decls)))
(when (member a (cddr x))
(return-from find-type (second (second x))))
t)))
(cond
((subtypep (first (second x)) 'string)
(return-from find-type 'character))
(t
(return-from find-type (second (second x)))))
t))))
(dolist (a arrays)
(let ((d-name (array-data-name a))
(o-name (array-offset-name a))
......@@ -3861,7 +3865,7 @@
;;;-----------------------------------------------------------------------------
;;; end of f2cl5.l
;;;
;;; $Id: f2cl5.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $
;;; $Id: f2cl5.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $
;;; $Log$
;;; Revision 1.204 2010/02/23 05:21:30 rtoy
;;; Fix declaration for default integer type. Previously the type was
......
......@@ -6,7 +6,7 @@
(in-package :f2cl-lib)
(defparameter *f2cl-macros-version*
"$Id: macros.l,v fceac530ef0c 2011/11/26 04:02:26 toy $")
"$Id: macros.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $")
(eval-when
#+gcl (compile load eval)
......@@ -158,13 +158,16 @@ is not included")
(dolist (a (reverse array-info))
(destructuring-bind (array a-type var-name offset-var)
a
(setf results
`((multiple-value-bind (,var-name ,offset-var)
(find-array-data ,array)
(declare (ignorable ,offset-var ,var-name)
(type f2cl-lib:integer4 ,offset-var)
(type (simple-array ,a-type (*)) ,var-name))
,@results)))))
(let ((atype (if (subtypep a-type 'character)
`(simple-string)
`(simple-array ,a-type (*)))))
(setf results
`((multiple-value-bind (,var-name ,offset-var)
(find-array-data ,array)
(declare (ignorable ,offset-var ,var-name)
(type f2cl-lib:integer4 ,offset-var)
(type ,atype ,var-name))
,@results))))))
(first results)))
(defmacro with-multi-array-data (array-info &rest body)
......@@ -1550,7 +1553,7 @@ causing all pending operations to be flushed"
;;;-------------------------------------------------------------------------
;;; end of macros.l
;;;
;;; $Id: macros.l,v fceac530ef0c 2011/11/26 04:02:26 toy $
;;; $Id: macros.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $
;;; $Log$
;;; Revision 1.117 2011/02/28 22:21:07 rtoy
;;; When opening an old file, we should set :if-exists to :overwrite to
......
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