Skip to content
Browse files

patch from Utz-Uwe Haus to add cltl2:variable-information support for…

… Allegro
  • Loading branch information...
1 parent 384376b commit 7fba88ad29bb4594ad63eada2d5172f8e63d5e1e @slyrus committed Mar 24, 2011
Showing with 14 additions and 5 deletions.
  1. +5 −3 opticl.lisp
  2. +9 −2 package.lisp
View
8 opticl.lisp
@@ -99,9 +99,11 @@
`(:element-type ,element-type))))))))
(frobber))
+;;; support functions/constants for the pixel setf-expander need to
+;;; exist at compile time
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun %get-image-dimensions (image-var env)
- #+(or sbcl ccl)
+ #+(or sbcl ccl allegro)
(when (symbolp image-var)
(multiple-value-bind (binding-type localp declarations)
(opticl-cltl2:variable-information image-var env)
@@ -110,9 +112,9 @@
(and type-decl
(listp type-decl)
(= (length type-decl) 4)
- (fourth type-decl)))))))
+ (fourth type-decl))))))
-(defconstant +max-image-channels+ 4)
+ (defconstant +max-image-channels+ 4))
(define-setf-expander pixel (image-var y x &environment env)
(multiple-value-bind (dummies vals newval setter getter)
View
11 package.lisp
@@ -161,5 +161,12 @@
(defpackage :opticl-cltl2
#+sbcl (:import-from :sb-cltl2 :variable-information)
#+ccl (:import-from :ccl :variable-information)
- #+(or sbcl ccl) (:export :variable-information))
-
+ #+(or sbcl ccl allegro) (:export :variable-information))
+
+#+allegro
+(defun opticl-cltl2:variable-information (symbol &optional env)
+ "A CLTL2-signature-compatible version of VARIABLE-INFORMATION on Allegro Common Lisp."
+ (multiple-value-bind (binding-type locative decl localp)
+ (sys:variable-information symbol env)
+ (declare (ignore locative))
+ (values binding-type localp decl)))

0 comments on commit 7fba88a

Please sign in to comment.
Something went wrong with that request. Please try again.