[movitz-cvs] CVS movitz/losp/muerte
ffjeld
ffjeld at common-lisp.net
Thu Apr 17 19:30:46 UTC 2008
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv14102
Modified Files:
loop.lisp
Log Message:
Make loop work at run-time.
--- /project/movitz/cvsroot/movitz/losp/muerte/loop.lisp 2008/03/15 20:57:44 1.8
+++ /project/movitz/cvsroot/movitz/losp/muerte/loop.lisp 2008/04/17 19:30:43 1.9
@@ -64,8 +64,19 @@
;;;(in-package :ansi-loop)
-(provide :muerte/loop :load-priority 0)
+(provide :muerte/loop :load-priority 1)
+#+movitz
+(progn
+ (defmacro movitz-macroexpand (&rest args)
+ `(macroexpand , at args))
+ (defmacro movitz-macroexpand-1 (&rest args)
+ `(macroexpand-1 , at args))
+ (eval-when (:compile-toplevel)
+ (defmacro movitz-macroexpand (&rest args)
+ `(movitz::movitz-macroexpand , at args))
+ (defmacro movitz-macroexpand-1 (&rest args)
+ `(movitz::movitz-macroexpand-1 , at args))))
;;;This is the "current" loop context in use when we are expanding a
;;;loop. It gets bound on each invocation of LOOP.
@@ -76,7 +87,7 @@
;;@@@@Explorer??
#-Genera `(copy-list ,l))
-(eval-when (:compile-toplevel)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *loop-real-data-type* 'real)
(defvar *loop-universe*)
@@ -256,12 +267,11 @@
, at body)))
-(defmacro/cross-compilation loop-collect-rplacd (&environment env
+(defmacro loop-collect-rplacd (&environment env
(head-var tail-var &optional user-head-var) form)
(declare
- #+LISPM (ignore head-var user-head-var) ;use locatives, unconditionally update through the tail.
- )
- (setq form (movitz::movitz-macroexpand form env))
+ #+LISPM (ignore head-var user-head-var)) ;use locatives, unconditionally update through the tail.
+ (setq form (movitz-macroexpand form env))
(flet ((cdr-wrap (form n)
(declare (fixnum n))
(do () ((<= n 4) (setq form `(,(case n
@@ -364,7 +374,7 @@
;;;; Maximization Technology
-(eval-when (:compile-toplevel :execute)
+(eval-when (:compile-toplevel :load-toplevel :execute)
#|
The basic idea of all this minimax randomness here is that we have to
@@ -494,7 +504,7 @@
;;;; Token Hackery
-(eval-when (:compile-toplevel #+movitz-loop :load-toplevel)
+(eval-when (:compile-toplevel :load-toplevel :execute)
;;;Compare two "tokens". The first is the frob out of *LOOP-SOURCE-CODE*,
@@ -712,7 +722,7 @@
-(eval-when (:compile-toplevel #+movitz-loop :load-toplevel)
+(eval-when (:compile-toplevel :load-toplevel :execute)
;;;; Code Analysis Stuff
@@ -812,8 +822,10 @@
(dolist (x l n) (incf n (estimate-code-size-1 x env))))))
;;@@@@ ???? (declare (function list-size (list) fixnum))
(cond ((constantp x #+Genera env) 1)
- ((symbolp x) (multiple-value-bind (new-form expanded-p) (movitz::movitz-macroexpand-1 x env)
- (if expanded-p (estimate-code-size-1 new-form env) 1)))
+ ((symbolp x)
+ (multiple-value-bind (new-form expanded-p)
+ (movitz-macroexpand-1 x env)
+ (if expanded-p (estimate-code-size-1 new-form env) 1)))
((atom x) 1) ;??? self-evaluating???
((symbolp (car x))
(let ((fn (car x)) (tem nil) (n 0))
@@ -848,7 +860,8 @@
((eq fn 'return-from) (1+ (estimate-code-size-1 (third x) env)))
((or (special-operator-p fn) (member fn *estimate-code-size-punt*))
(throw 'estimate-code-size nil))
- (t (multiple-value-bind (new-form expanded-p) (movitz::movitz-macroexpand-1 x env)
+ (t (multiple-value-bind (new-form expanded-p)
+ (movitz-macroexpand-1 x env)
(if expanded-p
(estimate-code-size-1 new-form env)
(f 3))))))))
@@ -864,14 +877,12 @@
(defun loop-error (format-string &rest format-args)
- #+movitz (declare (dynamic-extent format-args))
#+(or Genera CLOE) (declare (dbg:error-reporter))
#+Genera (setq format-args (copy-list format-args)) ;Don't ask.
(error "~?~%Current LOOP context:~{ ~S~}." format-string format-args (loop-context)))
(defun loop-warn (format-string &rest format-args)
- #+movitz (declare (dynamic-extent format-args))
(warn "~?~%Current LOOP context:~{ ~S~}." format-string format-args (loop-context)))
@@ -919,11 +930,11 @@
(loop-iteration-driver)
(loop-bind-block)
(let ((answer `(loop-body
- ,(nreverse *loop-prologue*)
- ,(nreverse *loop-before-loop*)
- ,(nreverse *loop-body*)
- ,(nreverse *loop-after-body*)
- ,(nreconc *loop-epilogue* (nreverse *loop-after-epilogue*)))))
+ ,(reverse *loop-prologue*)
+ ,(reverse *loop-before-loop*)
+ ,(reverse *loop-body*)
+ ,(reverse *loop-after-body*)
+ ,(revappend *loop-epilogue* (reverse *loop-after-epilogue*)))))
(do () (nil)
(setq answer `(block ,(pop *loop-names*) ,answer))
(unless *loop-names* (return nil)))
@@ -1234,7 +1245,7 @@
-(eval-when (:compile-toplevel #+movitz-loop :load-toplevel)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defun loop-get-collection-info (collector class default-type)
(let ((form (loop-get-form))
@@ -2037,10 +2048,6 @@
w))
-(defparameter *loop-ansi-universe*
- (make-ansi-loop-universe nil))
-
-
(defun loop-standard-expansion (keywords-and-forms environment universe)
(if (and keywords-and-forms (symbolp (car keywords-and-forms)))
(loop-translate keywords-and-forms environment universe)
@@ -2049,14 +2056,21 @@
)
+(eval-when (:compile-toplevel)
+ (defvar *loop-ansi-universe*
+ (make-ansi-loop-universe nil)))
+
+(eval-when (:load-toplevel :execute)
+ (defvar *loop-ansi-universe* nil))
+
;;;INTERFACE: ANSI
-(defmacro/cross-compilation loop (&rest keywords-and-forms)
+(defmacro loop (&rest keywords-and-forms)
#+Genera (declare (compiler:do-not-record-macroexpansions)
(zwei:indentation . zwei:indent-loop))
(loop-standard-expansion keywords-and-forms nil *loop-ansi-universe*))
;;;INTERFACE: Traditional, ANSI, Lucid.
-(defmacro/cross-compilation loop-finish ()
+(defmacro loop-finish ()
"Causes the iteration to terminate \"normally\", the same as implicit
termination by an iteration driving clause, or by use of WHILE or
UNTIL -- the epilogue code (if any) will be run, and any implicitly
@@ -2064,12 +2078,12 @@
'(go end-loop))
-(defmacro/cross-compilation loop-body (prologue
- before-loop
- main-body
- after-loop
- epilogue
- &aux (env nil) rbefore rafter flagvar)
+(defmacro loop-body (prologue
+ before-loop
+ main-body
+ after-loop
+ epilogue
+ &aux (env nil) rbefore rafter flagvar)
(unless (= (length before-loop) (length after-loop))
(error "LOOP-BODY called with non-synched before- and after-loop lists."))
;;All our work is done from these copies, working backwards from the end:
@@ -2141,7 +2155,7 @@
(return)))))))
-(defmacro/cross-compilation loop-really-desetq (&rest var-val-pairs &aux (env nil))
+(defmacro loop-really-desetq (&rest var-val-pairs &aux (env nil))
(labels ((find-non-null (var)
;; see if there's any non-null thing here
;; recurse if the list element is itself a list
@@ -2161,7 +2175,7 @@
(and (consp x)
(or (not (eq (car x) 'car))
(not (symbolp (cadr x)))
- (not (symbolp (setq x (movitz::movitz-macroexpand x env)))))
+ (not (symbolp (setq x (movitz-macroexpand x env)))))
(cons x nil)))
(cdr val))
`(,val))))
More information about the Movitz-cvs
mailing list