From: Mike Smith
Subject: Shortest path to compile Screamer for SBCL (on OS X)?
Date: Thu, 28 Apr 2005 03:54:57 +0000
Message-ID: <PNOdncP_C60Mw-3fRVn-qw@comcast.com> What's the quickest path to a working version of the Screamer package
(Siskind et al) using SBCL (on OS X)?
I've made a couple of naive attempts:
- tried a direct load (failed as expected).
- tried spoofing the features pretending SBCL is really CMUCL (further,
but still failed; not unexpected).
CLOCC's version looked hopeful, but SBCL doesn't appear to be a
supported CL variant from a review of the install instructions.
There appear to have been intrepid people who have been using Screamer
and SBCL together from fragmentary posts on the web and lisp threads,
but I've not uncovered the magic instructions or patches on how to pull
it all together.
Has this been solved already and not been posted -- or am I looking in
the wrong haystacks?
- Mike
(aspiring cons artist)
Managers are instinctively Lisp-averse because of the way losses are
presented on balance sheets. From: GP lisper
Subject: Re: Shortest path to compile Screamer for SBCL (on OS X)?
Date: Thu, 28 Apr 2005 07:57:44 +0000
Message-ID: <1114675222.4d570b62202f51f9ea39e9517ee08039@teranews> On Wed, 27 Apr 2005 23:54:57 -0400, <·············@comcast.net> wrote:
>
> What's the quickest path to a working version of the Screamer package
> (Siskind et al) using SBCL (on OS X)?
>
> I've made a couple of naive attempts:
>
> - tried a direct load (failed as expected).
And this is because? SBCL is known to be stricter, but you haven't
provided much of a clue. There are customized versions of Screamer
for CLISP and Cormanlisp should you wish to solve SBCL.
> Has this been solved already and not been posted -- or am I looking in
> the wrong haystacks?
;;; ===================================================
;;; === SCREAMER+ ===
;;; === increasing the expressiveness of SCREAMER ===
;;; ===================================================
;;; Description: This file contains functions which are arguably
;;; missing from the original implementation of SCREAMER
;;; The functions in this file are backwards compatible
;;; with those of SCREAMER; i.e., all SCREAMER programs
;;; should also work with SCREAMER+. However, the functions
;;; which are exclusive to SCREAMER+ often have superior
;;; propagation properties than those of SCREAMER.
;;; Happy Screaming!
;;;
;;; Simon White, February 2000 ······@csd.abdn.ac.uk
;;;
;;; Department of Computing Science
;;; King's College
;;; University of Aberdeen
;;; Aberdeen AB24 3UE
;;; Scotland, UK.
However, you still need Screamer.
;;; Screamer+ requires screamer
(unless (find-package :SCREAMER)
(load *screamer-path*)
)
--
Everyman has three hearts;
one to show the world, one to show friends, and one only he knows. From: Adam Warner
Subject: Re: Shortest path to compile Screamer for SBCL (on OS X)?
Date: Thu, 28 Apr 2005 05:04:48 +0000
Message-ID: <pan.2005.04.28.05.04.41.221158@consulting.net.nz> On Wed, 27 Apr 2005 23:54:57 -0400, Mike Smith wrote:
> What's the quickest path to a working version of the Screamer package
> (Siskind et al) using SBCL (on OS X)?
I "ported" Screamer to SBCL etc. for Debian a while ago and I've just
tested that (require 'screamer) still works:
<http://packages.debian.org/unstable/devel/cl-screamer>
You could just grab the latest original source plus diff from the link
above.
I quoted "ported" because I made the minimal number of changes necessary
to compile/clean up the code without actually understanding how the code
works (very few people understand Screamer's code). I'm yet to use
Screamer.
If it's any help here are my incremental diffs in reverse chronological
order that I've extracted from my Sent box:
diff -ur cl-screamer-3.24.1-3/debian/changelog cl-screamer-3.24.1-4/debian/changelog
--- cl-screamer-3.24.1-3/debian/changelog 2004-03-16 14:11:51.000000000 +1300
+++ cl-screamer-3.24.1-4/debian/changelog 2004-03-16 23:20:25.000000000 +1300
@@ -1,3 +1,10 @@
+cl-screamer (3.24.1-4) unstable; urgency=low
+
+ * CLOS class and method to permit the duplicate definition warnings, thanks
+ Nikodemus Siivola.
+
+ -- Adam Warner <····@macrology.co.nz> Tue, 16 Mar 2004 23:16:11 +1300
+
cl-screamer (3.24.1-3) unstable; urgency=low
* CLISP and GCL is conditionalised the same as CMUCL and SBCL.
diff -ur cl-screamer-3.24.1-3/equations.lisp cl-screamer-3.24.1-4/equations.lisp
--- cl-screamer-3.24.1-3/equations.lisp 2004-03-16 14:04:18.000000000 +1300
+++ cl-screamer-3.24.1-4/equations.lisp 2004-03-16 23:14:40.000000000 +1300
@@ -4,10 +4,6 @@
(in-package :screamer-user)
-#+sbcl (eval-when (:compile-toplevel :load-toplevel :execute)
- (setf asdf:*compile-file-failure-behaviour*
- screamer-system::*asdf-compile-file-failure-behaviour*))
-
#-(or poplog akcl)
(screamer:define-screamer-package :screams (:use :iterate))
diff -ur cl-screamer-3.24.1-3/screamer.asd cl-screamer-3.24.1-4/screamer.asd
--- cl-screamer-3.24.1-3/screamer.asd 2004-03-16 14:03:06.000000000 +1300
+++ cl-screamer-3.24.1-4/screamer.asd 2004-03-16 23:14:20.000000000 +1300
@@ -6,12 +6,11 @@
(defpackage #:screamer-system (:use #:asdf #:cl))
(in-package #:screamer-system)
-;;4 Duplicate definition warnings in screams.lisp will not abort compilation.
-;;equations.lisp resets ASDF:*COMPILE-FILE-FAILURE-BEHAVIOUR* to its default.
-#+sbcl (defvar *asdf-compile-file-failure-behaviour*
- (prog1
- asdf:*compile-file-failure-behaviour*
- (setf asdf:*compile-file-failure-behaviour* :warn)))
+(defclass file-warn-only (cl-source-file) ())
+
+(defmethod perform :around ((op compile-op) (c file-warn-only))
+ (setf (operation-on-failure op) :warn)
+ (call-next-method))
(defsystem screamer
:depends-on (:cl-plus)
@@ -19,9 +18,11 @@
((:file "screamer")
(:file "iterate")
(:file "primordial" :depends-on ("iterate" "screamer"))
- (:file "screams" :depends-on ("iterate" "screamer"))
+ ;;Permit four Duplicate definition warnings generated by SBCL
+ (file-warn-only "screams" :depends-on ("iterate" "screamer"))
(:file "equations" :depends-on ("iterate" "screamer")))
:perform (compile-op :after (op c)
(print (funcall (intern
"PRIME-ORDEAL" "PRIMORDIAL")))))
+
=========================================================================
diff -u -r cl-screamer-3.24.1-2/debian/changelog cl-screamer-3.24.1-3/debian/changelog
--- cl-screamer-3.24.1-2/debian/changelog 2004-03-15 21:02:42.000000000 +1300
+++ cl-screamer-3.24.1-3/debian/changelog 2004-03-16 14:11:51.000000000 +1300
@@ -1,3 +1,14 @@
+cl-screamer (3.24.1-3) unstable; urgency=low
+
+ * CLISP and GCL is conditionalised the same as CMUCL and SBCL.
+ * SBCL: screams.lisp compiles regardless of 4 Duplicate definition warnings
+ because ASDF:*COMPILE-FILE-FAILURE-BEHAVIOUR* is set to :WARN in
+ screamer.asd and reset to its default in equations.lisp.
+ * EVAL-WHEN's deprecated symbols were changed to ANSI keywords.
+ * Fixed WALK-EVAL-WHEN to handle the ANSI keywords.
+
+ -- Adam Warner <····@macrology.co.nz> Tue, 16 Mar 2004 14:11:56 +1300
+
cl-screamer (3.24.1-2) unstable; urgency=low
* cl-screamer now depends upon the cl-plus package for CL+:DEFCONST
diff -u -r cl-screamer-3.24.1-2/equations.lisp cl-screamer-3.24.1-3/equations.lisp
--- cl-screamer-3.24.1-2/equations.lisp 2004-03-15 18:37:28.000000000 +1300
+++ cl-screamer-3.24.1-3/equations.lisp 2004-03-16 14:04:18.000000000 +1300
@@ -2,7 +2,11 @@
;;; LaHaShem HaAretz U'Mloah
-#||#(in-package :screamer-user)
+(in-package :screamer-user)
+
+#+sbcl (eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf asdf:*compile-file-failure-behaviour*
+ screamer-system::*asdf-compile-file-failure-behaviour*))
#-(or poplog akcl)
(screamer:define-screamer-package :screams (:use :iterate))
diff -u -r cl-screamer-3.24.1-2/iterate.lisp cl-screamer-3.24.1-3/iterate.lisp
--- cl-screamer-3.24.1-2/iterate.lisp 2004-03-15 18:37:29.000000000 +1300
+++ cl-screamer-3.24.1-3/iterate.lisp 2004-03-16 11:31:44.000000000 +1300
@@ -127,7 +127,7 @@
(:export :iterate :iter :display-iterate-clauses :declare-variables
:defmacro-clause :defclause-sequence :dsetq :initially
:after-each :finally :if-first-time :finally-protected
- #-(or cmu sbcl) :finish
+ #-(or cmu sbcl clisp gcl) :finish
:leave :next-iteration :next :terminate :repeat :for :as
:generate :generating :in :sum :summing :multiply :multiplying
:maximize :minimize :maximizing :minimizing :counting :always
@@ -300,7 +300,7 @@
(defvar *clause-info-index* '(:index))
-(eval-when (compile)
+(eval-when (:compile-toplevel)
;; This is so the variable has a value when we compile this file, since
;; the process of compilation results in actually setting things up.
(if (not (boundp '*clause-info-index*))
@@ -383,7 +383,7 @@
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
;;; Clause-info structures, which are put in the clause index.
(defstruct clause-info
@@ -419,7 +419,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Macros.
-(eval-when (compile load eval) ;; Allegro needs this
+(eval-when (:compile-toplevel :load-toplevel :execute) ;; Allegro needs this
(defmacro assertion (test)
`(if (not ,test) (bug "Assertion ~a failed" ',test)))
@@ -435,7 +435,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SharpL.
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defun sharpL-reader (stream subchar n-args)
(declare (ignore subchar))
(let* ((form (read stream t nil t))
@@ -462,7 +462,7 @@
(subbed-body (sublis (pairlis bvars args) body)))
`#'(lambda ,args ,.subbed-body)))))
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(set-dispatch-macro-character #\# #\L 'sharpL-reader)
@@ -1001,7 +1001,7 @@
(or (get symbol 'synonym) symbol))
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defun listify (x)
(if (listp x) x (list x)))
@@ -1149,7 +1149,7 @@
;;; The code generated by DEFINE-CLAUSE (below) is the only code that the
;;; invokes this.
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defun install-clause-info (req-keywords keywords function doc-string
generator?)
@@ -1307,7 +1307,7 @@
; (define-clause 'defun clause-template for-body)
; (define-clause 'defun gen-clause-template gen-body)))
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(cl+:defconst sequence-keyword-list
'(:from from :upfrom upfrom :downfrom downfrom :to to :downto downto
@@ -1377,7 +1377,7 @@
;; must be eq to (hence in the same package as) the first symbol of
;; the defined clause; but the packages of the other symbols don't
;; matter.
- `(eval-when (compile load eval)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(,define-form ,func-name ,arglist ,@body)
(install-clause-info ',req-kws-but-first
',keywords&opt
@@ -1430,7 +1430,7 @@
(defmacro defsynonym (syn word)
;; Makes SYN a synonym for the existing iterate keyword WORD.
- `(eval-when (compile load eval)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (get ',syn 'synonym) ',word)))
@@ -1970,8 +1970,8 @@
nil)
((symbolp (car form))
(cond
- ((or (#-(or ansi-90 ansi-cl allegro cmu sbcl) special-form-p
- #+(or ansi-90 ansi-cl allegro cmu sbcl) special-operator-p (car form))
+ ((or (#-(or ansi-90 ansi-cl allegro cmu sbcl clisp gcl) special-form-p
+ #+(or ansi-90 ansi-cl allegro cmu sbcl clisp gcl) special-operator-p (car form))
(member (car form) '(flet labels let let*))) ; Lucid doesn't think
; that these are
; special forms.
@@ -3416,7 +3416,8 @@
`(progn (setq *print-pretty* t) (macroexpand-1 ',x)))
-(eval-when (compile load eval) (setq *readtable* (copy-readtable nil)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq *readtable* (copy-readtable nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Junk.
diff -u -r cl-screamer-3.24.1-2/primordial.lisp cl-screamer-3.24.1-3/primordial.lisp
--- cl-screamer-3.24.1-2/primordial.lisp 2004-03-15 18:37:28.000000000 +1300
+++ cl-screamer-3.24.1-3/primordial.lisp 2004-03-16 13:58:41.000000000 +1300
@@ -6,14 +6,12 @@
;;; release. Run the function (PRIME-ORDEAL). If it returns T and doesn't
;;; produce any error messages then Screamer is probably OK.
-;;; CMU CommonLisp has a bug with DEFPACKAGE.
+#-(or poplog akcl cmu sbcl clisp gcl) (in-package :screamer-user)
-#-(or poplog akcl cmu sbcl) (in-package :screamer-user)
-
-#-(or poplog akcl cmu sbcl)
+#-(or poplog akcl cmu sbcl clisp gcl)
(screamer:define-screamer-package :primordial (:use :iterate))
-#+(or cmu sbcl)
+#+(or cmu sbcl clisp gcl)
(defpackage :primordial
(:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p)
(:use :cl :screamer :iterate))
diff -u -r cl-screamer-3.24.1-2/screamer.asd cl-screamer-3.24.1-3/screamer.asd
--- cl-screamer-3.24.1-2/screamer.asd 2004-03-15 18:37:28.000000000 +1300
+++ cl-screamer-3.24.1-3/screamer.asd 2004-03-16 14:03:06.000000000 +1300
@@ -6,15 +6,22 @@
(defpackage #:screamer-system (:use #:asdf #:cl))
(in-package #:screamer-system)
+;;4 Duplicate definition warnings in screams.lisp will not abort compilation.
+;;equations.lisp resets ASDF:*COMPILE-FILE-FAILURE-BEHAVIOUR* to its default.
+#+sbcl (defvar *asdf-compile-file-failure-behaviour*
+ (prog1
+ asdf:*compile-file-failure-behaviour*
+ (setf asdf:*compile-file-failure-behaviour* :warn)))
+
(defsystem screamer
:depends-on (:cl-plus)
:components
- ((:file "screamer")
- (:file "iterate")
- (:file "primordial" :depends-on ("iterate" "screamer"))
- (:file "screams" :depends-on ("iterate" "screamer"))
- (:file "equations" :depends-on ("iterate" "screamer")))
+ ((:file "screamer")
+ (:file "iterate")
+ (:file "primordial" :depends-on ("iterate" "screamer"))
+ (:file "screams" :depends-on ("iterate" "screamer"))
+ (:file "equations" :depends-on ("iterate" "screamer")))
- :perform (compile-op :after (op c)
- (print (funcall (intern
- "PRIME-ORDEAL" "PRIMORDIAL")))))
+ :perform (compile-op :after (op c)
+ (print (funcall (intern
+ "PRIME-ORDEAL" "PRIMORDIAL")))))
diff -u -r cl-screamer-3.24.1-2/screamer.lisp cl-screamer-3.24.1-3/screamer.lisp
--- cl-screamer-3.24.1-2/screamer.lisp 2004-03-15 18:37:28.000000000 +1300
+++ cl-screamer-3.24.1-3/screamer.lisp 2004-03-16 11:27:47.000000000 +1300
@@ -530,7 +530,7 @@
;;; A kludge to get Screamer to run under Lucid 4.0.2 without CLIM 1.1 loaded
#+lucid
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package :cl)
(let* ((lisp-package (find-package :lisp))
(lisp-package-name (package-name lisp-package))
@@ -556,12 +556,12 @@
;;; MCL needs the extended LOOP macro since the default one expands into
;;; MACROLET which WALK can't handle.
-#+mcl (eval-when (compile load eval) (require :loop))
+#+mcl (eval-when (:compile-toplevel :load-toplevel :execute) (require :loop))
;;; note: This EVAL-WHEN shouldn't be necessary but it is due to a bug in
;;; Lucid.
#-(or poplog akcl)
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage :screamer
(:shadow :defun :multiple-value-bind :y-or-n-p :variable)
(:use :cl #+lucid :lcl)
@@ -756,7 +756,7 @@
;;; A kludge to get Screamer to run under Poplog or AKCL
#+(or poplog akcl)
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package :cl)
(let* ((lisp-package (find-package :lisp))
(lisp-package-name (package-name lisp-package))
@@ -789,7 +789,7 @@
(defmacro define-screamer-package (defined-package-name &rest options)
;; note: This EVAL-WHEN shouldn't be necessary but it is due to a bug in
;; Lucid.
- `(eval-when (compile load eval)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage ,defined-package-name ,@options
(:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p)
(:use :cl #+lucid :lcl :screamer))))
@@ -804,23 +804,24 @@
'(shadowing-import '(defun multiple-value-bind y-or-n-p) :screamer-user)))
(defmacro defstruct-compile-time (options &body items)
- `(eval-when (compile load eval) (defstruct ,options ,@items)))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defstruct ,options ,@items)))
(defmacro defvar-compile-time (name &optional initial-value documentation)
- `(eval-when (compile load eval)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar ,name ,initial-value ,documentation)))
(defmacro defun-compile-time (function-name lambda-list &body body)
- `(eval-when (compile load eval)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(cl:defun ,function-name ,lambda-list ,@body)
- #-(or akcl harlequin-common-lisp clisp)
- (eval-when (compile) (compile ',function-name))))
+ #-(or akcl harlequin-common-lisp)
+ (eval-when (:compile-toplevel) (compile ',function-name))))
;;; Needed because Allegro has some bogosity whereby (MACRO-FUNCTION <m> <e>)
;;; returns NIL during compile time when <m> is a macro being defined for the
;;; first time in the file being compiled.
(defmacro defmacro-compile-time (function-name lambda-list &body body)
- `(eval-when (compile load eval)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro ,function-name ,lambda-list ,@body)))
(defparameter *screamer-version* "3.24"
@@ -1180,8 +1181,8 @@
(unless (null (rest (last (second form))))
(error "Improper list of SITUATIONS: ~S" form))
(unless (every #'(lambda (situation)
- (member situation '(:compile-top-level
- :load-top-level
+ (member situation '(:compile-toplevel
+ :load-toplevel
:execute
compile
load
@@ -1303,10 +1304,10 @@
((valid-function-name? (second form))
(cond
((symbolp (second form))
- (if (or (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl))
+ (if (or (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl clisp gcl))
special-form-p
#+lucid lisp:special-form-p
- #+(or ansi-90 ansi-cl allegro cmu sbcl) special-operator-p
+ #+(or ansi-90 ansi-cl allegro cmu sbcl clisp gcl) special-operator-p
(second form))
;; note: Allegro has some braindamage in the way it treats
;; some macros as special forms and refuses to
@@ -2052,9 +2053,9 @@
(macro-function (first form) #-(or poplog akcl) environment)))
(walk-macro-call
map-function reduce-function screamer? partial? nested? form environment))
- ((#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl)) special-form-p
+ ((#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl clisp gcl)) special-form-p
#+lucid lisp:special-form-p
- #+(or ansi-90 ansi-cl allegro cmu sbcl) special-operator-p
+ #+(or ansi-90 ansi-cl allegro cmu sbcl clisp gcl) special-operator-p
(first form))
(error "Cannot (currently) handle the special form ~S" (first form)))
(t (walk-function-call
@@ -2272,9 +2273,9 @@
(let ((d (gensym "DUMMY-"))
(dummy-argument (gensym "DUMMY-")))
(cl:multiple-value-bind (vars vals stores store-form access-form)
- (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl)) get-setf-method
+ (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl clisp gcl)) get-setf-method
#+lucid lisp:get-setf-method
- #+(or ansi-90 ansi-cl allegro cmu sbcl) get-setf-expansion
+ #+(or ansi-90 ansi-cl allegro cmu sbcl clisp gcl) get-setf-expansion
;; note: Poplog and AKCL only support CLtL1.
(first pairs) #-(or poplog akcl) environment)
`(let* (,@(mapcar #'list vars vals)
@@ -2859,9 +2860,9 @@
(dummy-argument (gensym "DUMMY-"))
(other-arguments (gensym "OTHER-")))
(cl:multiple-value-bind (vars vals stores store-form access-form)
- (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl)) get-setf-method
+ (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl clisp gcl)) get-setf-method
#+lucid lisp:get-setf-method
- #+(or ansi-90 ansi-cl allegro cmu sbcl) get-setf-expansion
+ #+(or ansi-90 ansi-cl allegro cmu sbcl clisp gcl) get-setf-expansion
;; note: Poplog and AKCL only support CLtL1.
(first arguments) #-(or poplog akcl) environment)
(cps-convert
@@ -3341,7 +3342,7 @@
function-record-old-deterministic?)
(setf (function-record-screamer? function-record)
function-record-screamer?)
- `(eval-when (compile load eval)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(cache-definition ',function-name ',lambda-list ',body ',callees)
,@modified-function-definitions
',function-name)))))
@@ -3456,7 +3457,7 @@
;;; note: Should have way of having a stream of values.
-(eval-when (compile load eval) (setf *screamer?* t))
+(eval-when (:compile-toplevel :load-toplevel :execute) (setf *screamer?* t))
(defun print-nondeterministic-function
(nondeterministic-function stream print-level)
@@ -3465,7 +3466,7 @@
'nondeterministic
(nondeterministic-function-function nondeterministic-function)))
-(eval-when (compile load eval) (declare-nondeterministic 'a-boolean))
+(eval-when (:compile-toplevel :load-toplevel :execute) (declare-nondeterministic 'a-boolean))
(cl:defun a-boolean ()
(screamer-error
@@ -3498,7 +3499,7 @@
(defun nondeterministic-function? (thing)
(nondeterministic-function?-internal (value-of thing)))
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(declare-nondeterministic 'funcall-nondeterministic))
(cl:defun funcall-nondeterministic (function &rest arguments)
@@ -3516,7 +3517,7 @@
arguments)
(funcall continuation (apply function arguments)))))
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(declare-nondeterministic 'apply-nondeterministic))
(cl:defun apply-nondeterministic (function argument &rest arguments)
@@ -3580,7 +3581,7 @@
;;; failure counts generated by COUNT-FAILURES. A small price to pay for
;;; tail recursion optimization.
-(eval-when (compile load eval) (declare-nondeterministic 'an-integer))
+(eval-when (:compile-toplevel :load-toplevel :execute) (declare-nondeterministic 'an-integer))
(cl:defun an-integer ()
(screamer-error
@@ -3595,7 +3596,7 @@
(choice-point-internal (funcall continuation (- i)))
(incf i)))))
-(eval-when (compile load eval) (declare-nondeterministic 'an-integer-above))
+(eval-when (:compile-toplevel :load-toplevel :execute) (declare-nondeterministic 'an-integer-above))
(cl:defun an-integer-above (low)
(declare (ignore low))
@@ -3610,7 +3611,7 @@
(loop (choice-point-internal (funcall continuation i))
(incf i))))))
-(eval-when (compile load eval) (declare-nondeterministic 'an-integer-below))
+(eval-when (:compile-toplevel :load-toplevel :execute) (declare-nondeterministic 'an-integer-below))
(cl:defun an-integer-below (high)
(declare (ignore high))
@@ -3625,7 +3626,7 @@
(loop (choice-point-internal (funcall continuation i))
(decf i))))))
-(eval-when (compile load eval) (declare-nondeterministic 'an-integer-between))
+(eval-when (:compile-toplevel :load-toplevel :execute) (declare-nondeterministic 'an-integer-between))
(cl:defun an-integer-between (low high)
(declare (ignore low high))
@@ -3642,7 +3643,7 @@
(choice-point-internal (funcall continuation i))))
(funcall continuation high))))
-(eval-when (compile load eval) (declare-nondeterministic 'a-member-of))
+(eval-when (:compile-toplevel :load-toplevel :execute) (declare-nondeterministic 'a-member-of))
(cl:defun a-member-of (sequence)
(declare (ignore sequence))
@@ -3712,7 +3713,7 @@
;;; note: Enable this line to use CLOS instead of DEFSTRUCT for variables.
#|
-(eval-when (compile load eval) (pushnew :screamer-clos *features* :test #'eq))
+(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :screamer-clos *features* :test #'eq))
|#
#-screamer-clos
@@ -6904,8 +6905,10 @@
#-harlequin-common-lisp
(defun template (template) (template-internal (value-of template) '()))
-(eval-when (compile load eval) (setf *screamer?* nil))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf *screamer?* nil))
-(eval-when (compile load eval) (pushnew :screamer *features* :test #'eq))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :screamer *features* :test #'eq))
;;; Tam V'Nishlam Shevah L'El Borei Olam
diff -u -r cl-screamer-3.24.1-2/screams.lisp cl-screamer-3.24.1-3/screams.lisp
--- cl-screamer-3.24.1-2/screams.lisp 2004-03-15 18:37:29.000000000 +1300
+++ cl-screamer-3.24.1-3/screams.lisp 2004-03-16 13:58:24.000000000 +1300
@@ -2,7 +2,7 @@
;;; LaHaShem HaAretz U'Mloah
-#||#(in-package :screamer-user)
+(in-package :screamer-user)
#-(or poplog akcl)
(screamer:define-screamer-package :screams (:use :iterate))
@@ -13,35 +13,6 @@
#+(or poplog akcl)
(use-package :iterate)
-;;; An example SBCL Duplicate definition warning
-;;;
-; in: DEFUN PARSE
-; (SCREAMER::DEFUN SCREAMS::PARSE
-; (SCREAMS::CATEGORY SCREAMS::WORDS)
-; (IF (NULL (REST SCREAMS::WORDS))
-; (IF (EQ SCREAMS::CATEGORY #) T (SCREAMER:FAIL))
-; (SCREAMS::PARSE-RULE SCREAMS::CATEGORY
-; SCREAMS::WORDS
-; SCREAMS::*GRAMMAR*)))
-; --> EVAL-WHEN DEFUN PROGN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA
-; ==>
-; #'(SB-INT:NAMED-LAMBDA SCREAMS::PARSE-CATEGORIES
-; (SCREAMS::CATEGORIES SCREAMS::WORDS1
-; &OPTIONAL
-; SCREAMS::WORDS2)
-; (DECLARE
-; (IGNORE SCREAMS::WORDS2
-; SCREAMS::WORDS1
-; SCREAMS::CATEGORIES))
-; (BLOCK SCREAMS::PARSE-CATEGORIES
-; (SCREAMER::SCREAMER-ERROR
-; "Function ~S is a nondeterministic function. As such, it~%~
-; must be called only from a nondeterministic context." ..)))
-;
-; caught WARNING:
-; Duplicate definition for PARSE-CATEGORIES found in one static unit (usually
-; a file).
-
(defun pythagorean-triples (n)
(all-values
(let ((a (an-integer-between 1 n))
=========================================================================
diff -u -r cl-screamer-3.24.1/debian/changelog cl-screamer-3.24.1-2/debian/changelog
--- cl-screamer-3.24.1/debian/changelog 2004-03-15 18:44:46.000000000 +1300
+++ cl-screamer-3.24.1-2/debian/changelog 2004-03-15 18:42:49.000000000 +1300
@@ -1,3 +1,11 @@
+cl-screamer (3.24.1-2) unstable; urgency=low
+
+ * cl-screamer now depends upon the cl-plus package for CL+:DEFCONST
+ * The ITERATE package will now compile with a readtable mode of :INVERT
+ * Additional SBCL-related fixes (mainly implementation conditionals)
+
+ -- Adam Warner <····@macrology.co.nz> Mon, 15 Mar 2004 18:41:11 +1300
+
cl-screamer (3.24.1-1) unstable; urgency=low
* New upstream (closes:198635)
diff -u -r cl-screamer-3.24.1/debian/control cl-screamer-3.24.1-2/debian/control
--- cl-screamer-3.24.1/debian/control 2004-03-15 18:44:46.000000000 +1300
+++ cl-screamer-3.24.1-2/debian/control 2004-03-15 12:46:04.000000000 +1300
@@ -7,10 +7,7 @@
Package: cl-screamer
Architecture: all
-Depends: ${shlibs:Depends}, common-lisp-controller
+Depends: ${shlibs:Depends}, common-lisp-controller, cl-plus
Description: Common Lisp package for non-determinate programming
This is Screamer - an extension of Common Lisp that adds support for
nondeterministic programming.
-
-
-
diff -u -r cl-screamer-3.24.1/iterate.lisp cl-screamer-3.24.1-2/iterate.lisp
--- cl-screamer-3.24.1/iterate.lisp 2003-04-08 04:56:22.000000000 +1200
+++ cl-screamer-3.24.1-2/iterate.lisp 2004-03-15 15:58:12.000000000 +1300
@@ -127,7 +127,7 @@
(:export :iterate :iter :display-iterate-clauses :declare-variables
:defmacro-clause :defclause-sequence :dsetq :initially
:after-each :finally :if-first-time :finally-protected
- #-cmu :finish
+ #-(or cmu sbcl) :finish
:leave :next-iteration :next :terminate :repeat :for :as
:generate :generating :in :sum :summing :multiply :multiplying
:maximize :minimize :maximizing :minimizing :counting :always
@@ -161,11 +161,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constants and global variables.
-(defconstant version "1.2" "Current version of Iterate")
+(cl+:defconst version "1.2" "Current version of Iterate")
-(defconstant standard-type-symbols
+(cl+:defconst standard-type-symbols
'(array atom bignum bit bit-vector character common compiled-function
complex cons double-float fixnum float function hash-table integer
keyword list long-float nil null number package pathname random-state
@@ -177,7 +177,7 @@
;;; These next two can be used for maximizing and minimizing.
-(defconstant smallest-number-alist
+(cl+:defconst smallest-number-alist
`((fixnum . ,most-negative-fixnum)
(float . ,most-negative-long-float)
(long-float . ,most-negative-long-float)
@@ -185,7 +185,7 @@
(double-float . ,most-negative-double-float)
(single-float . ,most-negative-single-float)))
-(defconstant largest-number-alist
+(cl+:defconst largest-number-alist
`((fixnum . ,most-positive-fixnum)
(float . ,most-positive-long-float)
(long-float . ,most-positive-long-float)
@@ -1309,9 +1309,9 @@
(eval-when (compile load eval)
-(defconstant sequence-keyword-list
- '(:FROM from :UPFROM upfrom :DOWNFROM downfrom :TO to :DOWNTO downto
- :ABOVE above :BELOW below :BY (by 1) :WITH-INDEX with-index))
+(cl+:defconst sequence-keyword-list
+ '(:from from :upfrom upfrom :downfrom downfrom :to to :downto downto
+ :above above :below below :by (by 1) :with-index with-index))
(defun define-clause (define-form clause-template body generator?)
;; CLAUSE-TEMPLATE is of the form
@@ -1970,8 +1970,8 @@
nil)
((symbolp (car form))
(cond
- ((or (#-(or ansi-90 ansi-cl allegro cmu) special-form-p
- #+(or ansi-90 ansi-cl allegro cmu) special-operator-p (car form))
+ ((or (#-(or ansi-90 ansi-cl allegro cmu sbcl) special-form-p
+ #+(or ansi-90 ansi-cl allegro cmu sbcl) special-operator-p (car form))
(member (car form) '(flet labels let let*))) ; Lucid doesn't think
; that these are
; special forms.
@@ -2216,40 +2216,40 @@
(setf (cdr entry) doc-string))
symbol))
-(def-special-clause INITIALLY (&rest forms)
+(def-special-clause initially (&rest forms)
"Lisp forms to execute before loop starts"
(mapc #'local-binding-check forms)
(return-code :initial (copy-list forms)))
-(def-special-clause AFTER-EACH (&rest forms)
+(def-special-clause after-each (&rest forms)
"Lisp forms to execute after each iteration"
(mapc #'local-binding-check forms)
(return-code :step (walk-list forms)))
;;; (copy-list forms)))
-(def-special-clause FINALLY (&rest forms)
+(def-special-clause finally (&rest forms)
"Lisp forms to execute after loop ends"
(mapc #'local-binding-check forms)
(return-code :final (copy-list forms)))
-(def-special-clause FINALLY-PROTECTED (&rest forms)
+(def-special-clause finally-protected (&rest forms)
"Lisp forms in an UNWIND-PROTECT after loop ends"
(mapc #'local-binding-check forms)
(return-code :final-protected (copy-list forms)))
-(def-special-clause IF-FIRST-TIME (then &optional else)
+(def-special-clause if-first-time (then &optional else)
(return-code :body (list (if-1st-time (list (walk-expr then))
(list (walk-expr else))))))
-(def-special-clause IN (block-name &rest forms)
+(def-special-clause in (block-name &rest forms)
"Process forms in a given Iterate block"
;; VALUE: depends on forms
(if (eq block-name *block-name*)
(walk-list forms)
`((in ,block-name ,@(copy-list forms)))))
-(def-special-clause NEXT (var &optional (n 1))
+(def-special-clause next (var &optional (n 1))
"Explicitly step a driver variable"
;; VALUE: var, after stepping.
;; Enclose the returned code in a PROGN so that the variable reference isn't
@@ -2312,7 +2312,7 @@
(defsynonym generating generate)
-(defclause (REPEAT n)
+(defclause (repeat n)
"Repeat the loop some number of times"
(top-level-check)
(let* ((c-type (or (expression-type n) 'fixnum))
@@ -2323,7 +2323,7 @@
:step `((setq ,count-var (1- ,count-var))))))
-(defclause-driver (FOR var-spec &sequence)
+(defclause-driver (for var-spec &sequence)
"Numbers"
(top-level-check)
(if with-index
@@ -2372,7 +2372,7 @@
;;;;;;;;;;;;;;;;;;;;;;;
;;; Sequence iteration
-(defclause-driver (FOR var-spec ON list &optional BY (step ''cdr))
+(defclause-driver (for var-spec on list &optional by (step ''cdr))
"Sublists of a list"
(top-level-check)
(let* ((var (extract-var var-spec))
@@ -2387,7 +2387,7 @@
list-var step))
:variable var)))
-(defclause-driver (FOR var IN list &optional BY (step ''cdr))
+(defclause-driver (for var in list &optional by (step ''cdr))
"Elements of a list"
(top-level-check)
(let* ((on-var (make-var-and-default-binding 'list :type 'list))
@@ -2416,7 +2416,7 @@
`(setq ,var (funcall ,step-var ,var))))))
-(defclause-sequence IN-VECTOR INDEX-OF-VECTOR
+(defclause-sequence in-vector index-of-vector
;; This doesn't observe fill-pointers.
:access-fn 'aref
:size-fn 'length
@@ -2424,7 +2424,7 @@
:element-doc-string "Elements of a vector"
:index-doc-string "Indices of a vector")
-(defclause-sequence IN-SEQUENCE INDEX-OF-SEQUENCE
+(defclause-sequence in-sequence index-of-sequence
;; This observes fill pointers, and works for any sequence.
:access-fn 'elt
:size-fn 'length
@@ -2432,7 +2432,7 @@
:element-doc-string "Elements of a sequence (vector or list)"
:index-doc-string "Indices of a sequence (vector or list)")
-(defclause-sequence IN-STRING INDEX-OF-STRING
+(defclause-sequence in-string index-of-string
:access-fn 'char
:size-fn 'length
:sequence-type 'string
@@ -2443,7 +2443,7 @@
;;; IN-HASHTABLE and IN-PACKAGE are cheats: we use the portable interface to
;;; make a list, then iterate over that.
-(defclause-driver (FOR key-val-vars IN-HASHTABLE table)
+(defclause-driver (for key-val-vars in-hashtable table)
"Elements of a hashtable"
;; This is just like FOR...IN.
(top-level-check)
@@ -2470,7 +2470,7 @@
(maphash #L(push (cons !1 !2) list) table)
list))
-(defclause-driver (FOR var IN-PACKAGE pkg &optional EXTERNAL-ONLY (ext nil))
+(defclause-driver (for var in-package pkg &optional external-only (ext nil))
"Symbols in a package"
(top-level-check)
(let ((on-var (make-var-and-default-binding 'list :type 'list)))
@@ -2492,12 +2492,12 @@
list))
-(defclause-driver (FOR var IN-FILE filename &optional USING (reader '#'read))
+(defclause-driver (for var in-file filename &optional using (reader '#'read))
"Forms in a file"
(top-level-check)
(return-stream-driver-code var filename reader :file generate))
-(defclause-driver (FOR var IN-STREAM stream &optional USING (reader '#'read))
+(defclause-driver (for var in-stream stream &optional using (reader '#'read))
"Forms in a stream"
(top-level-check)
(return-stream-driver-code var stream reader :stream generate))
@@ -2505,7 +2505,7 @@
(defun return-stream-driver-code (var thing reader stream-or-file generate)
(let* ((evar (extract-var var))
- (type (or (var-type evar) T))
+ (type (or (var-type evar) t))
(stream-var (make-var-and-binding 'stream nil))
(set-var (if (and (var-spec? var)
(subtypep 'symbol type))
@@ -2533,13 +2533,13 @@
-(defclause-driver (FOR var NEXT next)
+(defclause-driver (for var next next)
"General driver; VAR is set to value of NEXT"
(let ((setq (do-dsetq var next)))
(return-driver-code :variable var
:next (list setq))))
-(defclause-driver (FOR var DO-NEXT next)
+(defclause-driver (for var do-next next)
"General driver; VAR must be explicitly set"
(return-driver-code :variable var
:next (if (list-of-forms? next)
@@ -2587,7 +2587,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Variable binding and setting; pseudo-drivers.
-(defclause (WITH var &optional = (value nil supplied?))
+(defclause (with var &optional = (value nil supplied?))
"Bind a variable"
;; Special case: if value is not supplied, var can be a list of
;; variables, all bound defaultly.
@@ -2596,7 +2596,7 @@
(make-destructuring-bindings var value))
(return-code)) ; nothing to return
-(defclause (FOR var INITIALLY initial THEN then)
+(defclause (for var initially initial then then)
"Set var initially, then on subsequent iterations"
;; This is a pseudo-driver: it doesn't work with NEXT.
;; Set var in initialization code, then set it in the step section on
@@ -2608,7 +2608,7 @@
(return-code :initial initial-setq
:step then-setq)))
-(defclause (FOR var = expr)
+(defclause (for var = expr)
"Set a variable on each iteration"
;; Set var each time through the loop.
;; VALUE: expr.
@@ -2618,7 +2618,7 @@
(return-code :body code)))
-(defclause (FOR var FIRST first-expr THEN then-expr)
+(defclause (for var first first-expr then then-expr)
"Set var on first, and on subsequent, iterations"
;; Set var in the loop, but differently the first time. Most
;; inefficient of the three.
@@ -2661,7 +2661,7 @@
-(defclause (COUNTING expr &optional INTO var)
+(defclause (counting expr &optional into var)
"Increment a variable if expression is non-nil"
(return-reduction-code :identity 0
:operation '(subst (var exp) (1+ var))
@@ -2671,7 +2671,7 @@
:type 'fixnum
:accum-kind :increment))
-(defclause (SUM expr &optional INTO var)
+(defclause (sum expr &optional into var)
"Sum into a variable"
(return-reduction-code :identity 0
:operation '+
@@ -2684,7 +2684,7 @@
(defsynonym summing sum)
-(defclause (MULTIPLY expr &optional INTO var)
+(defclause (multiply expr &optional into var)
"Multiply into a variable"
(return-reduction-code :identity 1
:operation '*
@@ -2697,8 +2697,8 @@
(defsynonym multiplying multiply)
-(defclause (REDUCING expr BY op &optional INITIAL-VALUE (init-val nil iv?)
- INTO var-spec)
+(defclause (reducing expr by op &optional initial-value (init-val nil iv?)
+ into var-spec)
"Generalized reduction"
;; If we don't know the initial value, we can't use RETURN-REDUCTION-CODE.
;; We have to be inefficient and do something different the first time.
@@ -2734,14 +2734,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extrema.
-(defclause (MAXIMIZE expr &optional INTO var)
+(defclause (maximize expr &optional into var)
"Maximize value of an expression"
(return-extremum-code expr var 'max))
(defsynonym maximizing maximize)
-(defclause (MINIMIZE expr &optional INTO var)
+(defclause (minimize expr &optional into var)
"Minimize value of an expression"
(return-extremum-code expr var 'min))
@@ -2796,12 +2796,12 @@
"Exit the loop without running the epilogue code"
`(return-from ,*block-name* ,value))
-(defclause (WHILE expr)
+(defclause (while expr)
"Exit loop if test is nil"
(setq *loop-end-used?* t)
(return-code :body `((if (not ,(walk-expr expr)) (go ,*loop-end*)))))
-(defclause (UNTIL expr)
+(defclause (until expr)
"Exit loop if test is non-nil"
(setq *loop-end-used?* t)
(return-code :body `((if ,(walk-expr expr) (go ,*loop-end*)))))
@@ -2810,7 +2810,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Aggregated Boolean tests.
-(defclause (ALWAYS expr)
+(defclause (always expr)
"Return last value iff expression is always non-nil"
;; VALUE: expr
(setq expr (walk-expr expr))
@@ -2820,7 +2820,7 @@
(return-from ,*block-name* nil))))))
-(defclause (NEVER expr)
+(defclause (never expr)
"Return T iff expression is never non-nil"
;; VALUE: expr (which is always nil)
(setq expr (walk-expr expr))
@@ -2830,7 +2830,7 @@
-(defclause (THEREIS expr)
+(defclause (thereis expr)
"Return value of expression as soon as it is non-nil"
;; VALUE: expr (which is always nil)
(setq expr (walk-expr expr))
@@ -2842,8 +2842,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Finders.
-(defclause (FINDING expr SUCH-THAT test &optional INTO var-spec
- ON-FAILURE fval)
+(defclause (finding expr such-that test &optional into var-spec
+ on-failure fval)
"Return expression when test is non-nil"
;; VALUE: undefined.
(setq expr (walk-expr expr))
@@ -2867,11 +2867,11 @@
(setq ,var ,expr)
(go ,*loop-end*)))))))
-(defclause (FINDING expr MAXIMIZING max-expr &optional INTO variable)
+(defclause (finding expr maximizing max-expr &optional into variable)
"Return value which maximizes expression"
(return-find-extremum-code expr max-expr variable :max))
-(defclause (FINDING expr MINIMIZING min-expr &optional INTO variable)
+(defclause (finding expr minimizing min-expr &optional into variable)
"Return value which minimizes expression"
(return-find-extremum-code expr min-expr variable :min))
@@ -3023,8 +3023,8 @@
(coerce ,collect-var ',result-type)))))))))))
-(defclause (COLLECT expr &optional INTO var AT (place 'end)
- RESULT-TYPE (type 'list))
+(defclause (collect expr &optional into var at (place 'end)
+ result-type (type 'list))
"Collect into a list"
(return-collection-code
:variable var
@@ -3037,9 +3037,9 @@
(defsynonym collecting collect)
-(defclause (ADJOINING expr &optional INTO var AT (place 'end)
- TEST (test '#'eql)
- RESULT-TYPE (type 'list))
+(defclause (adjoining expr &optional into var at (place 'end)
+ test (test '#'eql)
+ result-type (type 'list))
"Adjoin into a list (tests for membership first)"
(if (duplicable? expr)
(return-collection-code
@@ -3067,7 +3067,7 @@
-(defclause (NCONCING expr &optional INTO var AT (place 'end))
+(defclause (nconcing expr &optional into var at (place 'end))
"Nconc into a list"
(return-collection-code
:variable var
@@ -3076,7 +3076,7 @@
:place place
:one-element nil))
-(defclause (APPENDING expr &optional INTO var AT (place 'end))
+(defclause (appending expr &optional into var at (place 'end))
"Append into a list"
(return-collection-code
:variable var
@@ -3086,8 +3086,8 @@
:place place
:one-element nil))
-(defclause (UNIONING expr &optional INTO var AT (place 'end)
- TEST (test '#'eql))
+(defclause (unioning expr &optional into var at (place 'end)
+ test (test '#'eql))
"Union into a list"
;; Can't use UNION because it says nothing about the order.
(return-collection-code
@@ -3103,8 +3103,8 @@
:place place
:one-element nil))
-(defclause (NUNIONING expr &optional INTO var AT (place 'end)
- TEST (test '#'eql))
+(defclause (nunioning expr &optional into var at (place 'end)
+ test (test '#'eql))
"Union into a list, destructively"
;; Can't use UNION because it says nothing about the order.
(return-collection-code
@@ -3121,8 +3121,8 @@
:one-element nil))
-(defclause (ACCUMULATE expr BY op &optional INITIAL-VALUE init-val
- INTO var-spec)
+(defclause (accumulate expr by op &optional initial-value init-val
+ into var-spec)
"Generalized accumulation"
;; This is just like REDUCING except, 1. the args to OP are in the other
;; order, and 2. if no initial value is supplied, NIL is used.
@@ -3133,7 +3133,7 @@
(setq op (third op)))
(let* ((var (extract-var var-spec))
(op-expr (make-funcall op (walk-expr expr) var)))
- (make-accum-var-binding var-spec init-val nil :type NIL)
+ (make-accum-var-binding var-spec init-val nil :type nil)
(return-code :body `((setq ,var ,op-expr)))))
(defsynonym accumulating accumulate)
@@ -3151,8 +3151,8 @@
;;; generator, the best we can do is use a flag for the first time.
-(defclause (FOR pvar PREVIOUS var &optional INITIALLY (default nil default?)
- BACK (n-expr 1))
+(defclause (for pvar previous var &optional initially (default nil default?)
+ back (n-expr 1))
"Previous value of a variable"
;; Set each save variable to the default in the initialization.
(top-level-check)
diff -u -r cl-screamer-3.24.1/primordial.lisp cl-screamer-3.24.1-2/primordial.lisp
--- cl-screamer-3.24.1/primordial.lisp 2003-04-08 02:42:39.000000000 +1200
+++ cl-screamer-3.24.1-2/primordial.lisp 2004-03-15 13:35:47.000000000 +1300
@@ -8,12 +8,12 @@
;;; CMU CommonLisp has a bug with DEFPACKAGE.
-#-(or poplog akcl cmu) (in-package :screamer-user)
+#-(or poplog akcl cmu sbcl) (in-package :screamer-user)
-#-(or poplog akcl cmu)
+#-(or poplog akcl cmu sbcl)
(screamer:define-screamer-package :primordial (:use :iterate))
-#+cmu
+#+(or cmu sbcl)
(defpackage :primordial
(:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p)
(:use :cl :screamer :iterate))
diff -u -r cl-screamer-3.24.1/screamer.asd cl-screamer-3.24.1-2/screamer.asd
--- cl-screamer-3.24.1/screamer.asd 2003-05-16 16:49:39.000000000 +1200
+++ cl-screamer-3.24.1-2/screamer.asd 2004-03-15 12:50:59.000000000 +1300
@@ -7,6 +7,7 @@
(in-package #:screamer-system)
(defsystem screamer
+ :depends-on (:cl-plus)
:components
((:file "screamer")
(:file "iterate")
diff -u -r cl-screamer-3.24.1/screamer.lisp cl-screamer-3.24.1-2/screamer.lisp
--- cl-screamer-3.24.1/screamer.lisp 2003-07-11 19:58:48.000000000 +1200
+++ cl-screamer-3.24.1-2/screamer.lisp 2004-03-15 13:37:57.000000000 +1300
@@ -1303,10 +1303,10 @@
((valid-function-name? (second form))
(cond
((symbolp (second form))
- (if (or (#+(not (or lucid ansi-90 ansi-cl allegro cmu))
+ (if (or (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl))
special-form-p
#+lucid lisp:special-form-p
- #+(or ansi-90 ansi-cl allegro cmu) special-operator-p
+ #+(or ansi-90 ansi-cl allegro cmu sbcl) special-operator-p
(second form))
;; note: Allegro has some braindamage in the way it treats
;; some macros as special forms and refuses to
@@ -2052,9 +2052,9 @@
(macro-function (first form) #-(or poplog akcl) environment)))
(walk-macro-call
map-function reduce-function screamer? partial? nested? form environment))
- ((#+(not (or lucid ansi-90 ansi-cl allegro cmu)) special-form-p
+ ((#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl)) special-form-p
#+lucid lisp:special-form-p
- #+(or ansi-90 ansi-cl allegro cmu) special-operator-p
+ #+(or ansi-90 ansi-cl allegro cmu sbcl) special-operator-p
(first form))
(error "Cannot (currently) handle the special form ~S" (first form)))
(t (walk-function-call
@@ -2272,9 +2272,9 @@
(let ((d (gensym "DUMMY-"))
(dummy-argument (gensym "DUMMY-")))
(cl:multiple-value-bind (vars vals stores store-form access-form)
- (#+(not (or lucid ansi-90 ansi-cl allegro cmu)) get-setf-method
+ (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl)) get-setf-method
#+lucid lisp:get-setf-method
- #+(or ansi-90 ansi-cl allegro cmu) get-setf-expansion
+ #+(or ansi-90 ansi-cl allegro cmu sbcl) get-setf-expansion
;; note: Poplog and AKCL only support CLtL1.
(first pairs) #-(or poplog akcl) environment)
`(let* (,@(mapcar #'list vars vals)
@@ -2859,9 +2859,9 @@
(dummy-argument (gensym "DUMMY-"))
(other-arguments (gensym "OTHER-")))
(cl:multiple-value-bind (vars vals stores store-form access-form)
- (#+(not (or lucid ansi-90 ansi-cl allegro cmu)) get-setf-method
+ (#+(not (or lucid ansi-90 ansi-cl allegro cmu sbcl)) get-setf-method
#+lucid lisp:get-setf-method
- #+(or ansi-90 ansi-cl allegro cmu) get-setf-expansion
+ #+(or ansi-90 ansi-cl allegro cmu sbcl) get-setf-expansion
;; note: Poplog and AKCL only support CLtL1.
(first arguments) #-(or poplog akcl) environment)
(cps-convert
diff -u -r cl-screamer-3.24.1/screams.lisp cl-screamer-3.24.1-2/screams.lisp
--- cl-screamer-3.24.1/screams.lisp 2003-04-08 02:42:39.000000000 +1200
+++ cl-screamer-3.24.1-2/screams.lisp 2004-03-15 18:27:17.000000000 +1300
@@ -13,6 +13,35 @@
#+(or poplog akcl)
(use-package :iterate)
+;;; An example SBCL Duplicate definition warning
+;;;
+; in: DEFUN PARSE
+; (SCREAMER::DEFUN SCREAMS::PARSE
+; (SCREAMS::CATEGORY SCREAMS::WORDS)
+; (IF (NULL (REST SCREAMS::WORDS))
+; (IF (EQ SCREAMS::CATEGORY #) T (SCREAMER:FAIL))
+; (SCREAMS::PARSE-RULE SCREAMS::CATEGORY
+; SCREAMS::WORDS
+; SCREAMS::*GRAMMAR*)))
+; --> EVAL-WHEN DEFUN PROGN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA
+; ==>
+; #'(SB-INT:NAMED-LAMBDA SCREAMS::PARSE-CATEGORIES
+; (SCREAMS::CATEGORIES SCREAMS::WORDS1
+; &OPTIONAL
+; SCREAMS::WORDS2)
+; (DECLARE
+; (IGNORE SCREAMS::WORDS2
+; SCREAMS::WORDS1
+; SCREAMS::CATEGORIES))
+; (BLOCK SCREAMS::PARSE-CATEGORIES
+; (SCREAMER::SCREAMER-ERROR
+; "Function ~S is a nondeterministic function. As such, it~%~
+; must be called only from a nondeterministic context." ..)))
+;
+; caught WARNING:
+; Duplicate definition for PARSE-CATEGORIES found in one static unit (usually
+; a file).
+
(defun pythagorean-triples (n)
(all-values
(let ((a (an-integer-between 1 n))
@@ -268,7 +297,7 @@
(parsev 's '(john walked to the table))))
(all-values
(FUNCALL (REORDER #'DOMAIN-SIZE
- #'(LAMBDA (X) (DECLARE (IGNORE X)) NIL)
+ (LAMBDA (X) (DECLARE (IGNORE X)) NIL)
#'<
#'LINEAR-FORCE)
(ITERATE (FOR (WORD CATEGORY) IN-HASHTABLE LEXICON)
=========================================================================
Regards,
Adam
* (require 'screamer)
; loading system definition from #P"/usr/share/common-lisp/systems/cl-plus.asd"
; into #<PACKAGE "ASDF3989">
; registering #<SYSTEM #:CL-PLUS {974A981}> as CL-PLUS
; compiling file "/usr/share/common-lisp/source/cl-plus/cl-plus.lisp" (written 15 MAR 2004 12:06:11 PM):
; compiling (IGNORE-ERRORS (MAKE-PACKAGE # ...)); in: LAMBDA NIL
; (SB-KERNEL:FLOAT-WAIT)
;
; note: deleting unreachable code
; compiling (IN-PACKAGE #:CL+)
; compiling (EXPORT (QUOTE DEFCONST))
; compiling (DEFMACRO DEFCONST ...)
; /var/cache/common-lisp-controller/adam/sbcl/cl-plus/cl-plus.fasl written
; compilation finished in 0:00:00
; compiling file "/usr/share/common-lisp/source/screamer/screamer.lisp" (written 30 MAR 2004 06:42:54 PM):
; compiling (IN-PACKAGE :CL-USER)
; compiling (DEFPACKAGE :SCREAMER ...)
; compiling (IN-PACKAGE :SCREAMER)
; compiling (DECLAIM (DECLARATION MAGIC))
[...]
; compiling (DEFUN NONLINEAR1 ...)
; compiling (DEFUN NONLINEAR2 ...)
; /var/cache/common-lisp-controller/adam/sbcl/screamer/equations.fasl written
; compilation finished in 0:00:04
;
; compilation unit finished
; caught 4 WARNING conditions
; printed 6 notes
; T
NIL
* From: Mike Smith
Subject: Re: Shortest path to compile Screamer for SBCL (on OS X)?
Date: Sat, 07 May 2005 22:40:36 +0000
Message-ID: <M4SdnR2Nq8913uDfRVn-sw@comcast.com> Adam Warner wrote:
>>What's the quickest path to a working version of the Screamer package
>>(Siskind et al) using SBCL (on OS X)?
>
>
> I "ported" Screamer to SBCL etc. for Debian a while ago and I've just
> tested that (require 'screamer) still works:
> <http://packages.debian.org/unstable/devel/cl-screamer>
Adam,
Thanks much, the debian 3.24 source was just what I needed.
The source loads and compiles. The primordial tests pass. I've
also run some of the "screams" functions successfully.
Now I've just need to figure out the rest with the Screamer papers.
- Mike Smith
(aspiring cons artist)
"Q: I don't get it -- how did CAR and CDR get those names?
A: They're acronyms based on the original functions:
CAR - cons-anterior-reference
CDR - cons-dorsal-reference"
- Apocryphal Lisp FAQ