Skip to content
Snippets Groups Projects
Commit e9f09f02 authored by Liam Healy's avatar Liam Healy
Browse files

Remove #m reader macro definition and make-load-form to foreign-array

parent 451bceda
No related branches found
No related tags found
No related merge requests found
;; A "marray" is an array in both GSL and CL
;; Liam Healy 2008-04-06 21:23:41EDT
;; Time-stamp: <2010-06-05 22:57:05EDT marray.lisp>
;; Time-stamp: <2010-06-24 20:03:33EDT marray.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -84,18 +84,6 @@
(set-struct-array-pointer object)
(call-next-method))
(defmethod make-load-form ((object marray) &optional env)
(declare (ignore env))
`(make-marray
',(element-type object)
:dimensions ',(dimensions object)
:initial-contents
',(loop for elt across
(subseq (c-array:original-array object)
(c-array:offset object)
(+ (c-array:offset object) (size object)))
collect elt)))
;;;;****************************************************************************
;;;; Definition of specific data classes
;;;;****************************************************************************
......@@ -165,62 +153,6 @@
:dimensions dimensions
keys))
;;; The reader macro #m will read a list of arguments, evaluating the
;;; contents, and construct a marray from it. If the symbol ^ occurs
;;; in the list, it indicates the object being made is a matrix, and
;;; this symbol indicates the end of each row. For compatibility
;;; reasons, a list of numeric values may be given for each row also.
;;; Examples:
;;; #m(1 2 (exp 1))
;;; #<VECTOR-DOUBLE-FLOAT #(1.0d0 2.0d0 2.7182817459106445d0)>
;;; #m(1 2 3 ^ pi (cos (/ pi 4)) -12)
;;; #<MATRIX-DOUBLE-FLOAT #2A((1.0d0 2.0d0 3.0d0)
;;; (3.141592653589793d0 0.7071067811865476d0 -12.0d0))>
;;; #2m(2 1 3 -1)
;;; #<VECTOR-COMPLEX-DOUBLE-FLOAT #(#C(2.0d0 1.0d0) #C(3.0d0 -1.0d0))>
(defun hashm-numeric-code (n)
"Get the appropriate element type for the numeric code n"
(case n
((nil 1) 'double-float)
(2 '(complex double-float))
(3 'single-float)
(4 '(complex single-float))
(7 '(signed-byte 8))
(8 '(unsigned-byte 8))
(15 '(signed-byte 16))
(16 '(unsigned-byte 16))
(31 '(signed-byte 32))
(32 '(unsigned-byte 32))
(63 '(signed-byte 64))
(64 '(unsigned-byte 64))))
(defun quote-numeric-list (s)
(if (and (listp s) (numberp (first s)))
`',s
s))
(defvar *row-separator* '^)
(export *row-separator*)
(defun conslist (l) (cons 'list l))
(set-dispatch-macro-character
#\# #\m
(lambda (stream subchar arg)
(declare (ignore subchar))
(read-char stream)
(let ((list (read-delimited-list #\) stream)))
`(make-marray
',(hashm-numeric-code arg)
:initial-contents
,(if (find *row-separator* list)
(conslist
(mapcar 'conslist
(cl-utilities:split-sequence *row-separator* list)))
`(list ,@(mapcar 'quote-numeric-list list)))))))
;;;;****************************************************************************
;;;; Copy to and from bare mpointers
;;;;****************************************************************************
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment