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 ,@args)) + (defmacro movitz-macroexpand-1 (&rest args) + `(macroexpand-1 ,@args)) + (eval-when (:compile-toplevel) + (defmacro movitz-macroexpand (&rest args) + `(movitz::movitz-macroexpand ,@args)) + (defmacro movitz-macroexpand-1 (&rest args) + `(movitz::movitz-macroexpand-1 ,@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 @@ ,@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))))