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 @@ ...@@ -17,7 +17,7 @@
"Use (f2cl-version) instead") "Use (f2cl-version) instead")
(defparameter *f2cl1-version* (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. ;; Forward declarations.
(defvar *f2cl2-version*) (defvar *f2cl2-version*)
...@@ -206,7 +206,7 @@ incorrect, so use caution.") ...@@ -206,7 +206,7 @@ incorrect, so use caution.")
(destructuring-bind (a &optional n l) (destructuring-bind (a &optional n l)
decl decl
(if (subtypep a 'string) (if (subtypep a 'string)
`(a ,(mapcar (constantly '*) l)) `(,a ,@(mapcar (constantly '*) l))
`(,a ,n ,(mapcar (constantly '*) l))))) `(,a ,n ,(mapcar (constantly '*) l)))))
(t (t
decl)))) decl))))
...@@ -3351,7 +3351,7 @@ loop2 ...@@ -3351,7 +3351,7 @@ loop2
;;;----------------------------------------------------------------------------- ;;;-----------------------------------------------------------------------------
;;; end of f2cl1.l ;;; 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$ ;;; $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 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 ;; functions for setting up varaible declarations and initialisations
(eval-when (compile load eval) (eval-when (compile load eval)
...@@ -2027,8 +2027,12 @@ ...@@ -2027,8 +2027,12 @@
(flet ((find-type (a) (flet ((find-type (a)
(dolist (x (rest (first formal-arg-decls))) (dolist (x (rest (first formal-arg-decls)))
(when (member a (cddr x)) (when (member a (cddr x))
(return-from find-type (second (second x)))) (cond
t))) ((subtypep (first (second x)) 'string)
(return-from find-type 'character))
(t
(return-from find-type (second (second x)))))
t))))
(dolist (a arrays) (dolist (a arrays)
(let ((d-name (array-data-name a)) (let ((d-name (array-data-name a))
(o-name (array-offset-name a)) (o-name (array-offset-name a))
...@@ -3861,7 +3865,7 @@ ...@@ -3861,7 +3865,7 @@
;;;----------------------------------------------------------------------------- ;;;-----------------------------------------------------------------------------
;;; end of f2cl5.l ;;; 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$ ;;; $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
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
(in-package :f2cl-lib) (in-package :f2cl-lib)
(defparameter *f2cl-macros-version* (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 (eval-when
#+gcl (compile load eval) #+gcl (compile load eval)
...@@ -158,13 +158,16 @@ is not included") ...@@ -158,13 +158,16 @@ is not included")
(dolist (a (reverse array-info)) (dolist (a (reverse array-info))
(destructuring-bind (array a-type var-name offset-var) (destructuring-bind (array a-type var-name offset-var)
a a
(setf results (let ((atype (if (subtypep a-type 'character)
`((multiple-value-bind (,var-name ,offset-var) `(simple-string)
(find-array-data ,array) `(simple-array ,a-type (*)))))
(declare (ignorable ,offset-var ,var-name) (setf results
(type f2cl-lib:integer4 ,offset-var) `((multiple-value-bind (,var-name ,offset-var)
(type (simple-array ,a-type (*)) ,var-name)) (find-array-data ,array)
,@results))))) (declare (ignorable ,offset-var ,var-name)
(type f2cl-lib:integer4 ,offset-var)
(type ,atype ,var-name))
,@results))))))
(first results))) (first results)))
(defmacro with-multi-array-data (array-info &rest body) (defmacro with-multi-array-data (array-info &rest body)
...@@ -1550,7 +1553,7 @@ causing all pending operations to be flushed" ...@@ -1550,7 +1553,7 @@ causing all pending operations to be flushed"
;;;------------------------------------------------------------------------- ;;;-------------------------------------------------------------------------
;;; end of macros.l ;;; 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$ ;;; $Log$
;;; Revision 1.117 2011/02/28 22:21:07 rtoy ;;; Revision 1.117 2011/02/28 22:21:07 rtoy
;;; When opening an old file, we should set :if-exists to :overwrite to ;;; 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