<div>
<div>
<span>Dear Pascal,</span></div><div><span><br></span></div><div><span>Thanks so much for the in depth explanation.</span></div><div><span>I had try your suggestions but never got the result I am looking for.</span></div><div><span><br></span></div><div><span>The entire code for the </span><span class="Apple-style-span" style="font-size: 12px; ">DIAGNOSE-QUIETLY:</span></div><div><span><br></span></div><div><span><p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">;;; -----------------------------------------------------------------------------</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">;;; DIAGNOSE-QUIETLY</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">;;; -----------------------------------------------------------------------------</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(defVar diagnose-verbose t)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(defVar $cr$ 'nil)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(defVar *compile-diagnose* nil)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(defParameter *current-evaluation* "")</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(defun diagnostic (&rest l) </p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (when l (setq *current-evaluation* (car l)))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (if diagnose-verbose</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (dolist (item l) </p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (if (eql item $cr$)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (terpri)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (princ item)))))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(defMacro do-quietly (name &body body)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> `(let ((temp diagnose-verbose)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (return-value nil))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (handler-case </p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (progn</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (setq diagnose-verbose nil)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (setq return-value (progn ,@body))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (setq diagnose-verbose temp)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> return-value)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (error (c)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (princ "ERROR! Check parameters.")</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (princ (documentation ',name 'function))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (print c)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (setq diagnose-verbose temp)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (abort)))))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(defun sum (n)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">"SUM (numbers)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> Returns the sum of the elements in a series of numbers.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> Examples:</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (sum '(1 2 3 4))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (sum '(1 2 3 -4))"</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (diagnostic "sum" $cr$)</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (do-quietly 'sum</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"> (reduce #'+ n)))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">The diagnostic function print the name and the result:</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(sum '(1 2 3 4))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">? sum</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">10</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">The do-quietly macro suppress the print of the sub</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">function (if any) and if error print the documentation string.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">The concept is to get the user quick help to resolved</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">the error with the arguments.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">Maybe the best way would be to have one function doing</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">the print of the NAME and result and if error the documentation.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">Let say the function name would be DIAGNOSE-QUIETLY.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">But I can't find the way to work. Therefore I use</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">one function for NAME and marcro function for error.</p><p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"><br></p><p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">the use would be like:</p><p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"><br></p><p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica"><span class="Apple-style-span" style="font-size: 13px; "></span></p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; ">(defun sum (n)</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; ">"SUM (numbers)</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "> Returns the sum of the elements in a series of numbers.</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "> Examples:</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "> (sum '(1 2 3 4))</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "> (sum '(1 2 3 -4))"</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "> (diagnose-quietly 'sum</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "> (reduce #'+ n)))</p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "><br></p><p style="margin-top: 0px; margin-right: 0px; margin-bottom: 0px; margin-left: 0px; font: normal normal normal 12px/normal Helvetica; "><br></p></span><p></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">For now, I am getting Stack overflow.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px"><br></p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">(sum '(1 2 3 y))</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">ERROR! Check parameters.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">> Error: Stack overflow on value stack.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">> While executing: symbol-package, in process Listener(13).</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">> Type cmd-. to abort, cmd-\ for a list of available restarts.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">> Type :? for other options.</p>
<p style="margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica">1 > </p><div><br></div>
<span>Janusz<br>--<div>MRAC Publishing</div><div>Janusz Podrazik</div><br></span>
<p style="color: #a0a0a0;">On Wednesday, 22 June 2011 at 01:16, Pascal J. Bourguignon wrote:</p>
<blockquote type="cite" style="border-left-style:solid;border-width:1px;margin-left:0px;padding-left:10px;">
<span><div><div>Janusz Podrazik <<a href="mailto:info@mracpublishing.com">info@mracpublishing.com</a>> writes:<br><br><blockquote type="cite"><div>What I am trying to do is to include function documentation from the<br>string to the error print.<br><br>(defMacro do-quietly (name &body body) ; with name<br> `(let ((temp diagnose-verbose)<br> (return-value nil))<br> (handler-case <br> (progn<br> (setq diagnose-verbose nil)<br> (setq return-value (progn ,@@body))<br> (setq diagnose-verbose temp)<br> return-value)<br> (error (c)<br> (princ ""ERROR! Check Arguments.")<br> (princ (documentation name 'function))<br> (print c)<br> (setq diagnose-verbose temp)<br> (abort)))))<br><br>(defun collect-sum (n)<br> "COLLECT-SUM (numbers)<br> Returns the sum of the elements in a series of numbers.<br> Examples:<br> (collect-sum '(1 2 3 4)<br> (collect-sum '(1 2 3 -4))"<br> (do-quietly 'collect-sum ;function name<br> (reduce #'+ n)))<br><br>4 > ERROR! Check Arguments.<br><blockquote type="cite"><div>Error: Unbound variable: name<br>While executing: collect-sum, in process Listener(13).<br>Type cmd-. to abort, cmd-\ for a list of available restarts.<br>Type :? for other options.<br></div></blockquote><br>whats wrong?<br></div></blockquote><br>You wrote a macro that generates code that makes reference to a variable<br>named NAME, while no such variable exist.<br><br>The parameters of the macros are known at compilation time only, when<br>macro expansion occurs. At run time, the macro doesn't exist anymore,<br>and neither do its parameters.<br><br>So you need to insert the name of the function in the code generated:<br><br> `... (princ (documentation ',name 'function)) ...<br><br>(Remember some function names are lists, so you must quote it for those<br>cases).<br><br><br>Now, your macro has a lot of problems:<br><br> (defmacro do-quietly (name &body body)<br> `(let ((temp diagnose-verbose)<br> (return-value nil))<br> (handler-case <br> (progn<br> (setq diagnose-verbose nil)<br> (setq return-value (progn ,@body))<br> (setq diagnose-verbose temp)<br> return-value)<br>> (error (c)<br> (princ "ERROR! Check Arguments.")<br> (princ (documentation ',name 'function))<br> (print c)<br> (setq diagnose-verbose temp)<br> (abort)))))<br><br>What's this free variable diagnose-verbose??<br>If that's a special variable, it should be named *diagnose-verbose*.<br>In that case, you can just use a dynamic binding to shadow its value:<br><br> (defmacro do-quietly (name &body body)<br> `(let ((return-value nil))<br> (handler-case <br> (let ((*diagnose-verbose* nil))<br> (setq return-value (progn ,@body))<br> return-value)<br> (error (c)<br> (princ "ERROR! Check Arguments.")<br> (princ (documentation ',name 'function))<br> (print c)<br> (abort)))))<br><br>Then, bodies may return several values, are you sure you want to throw<br>away all but the first? In any case, you should not use SETQ, but LET:<br><br> (defmacro do-quietly (name &body body)<br> ``(handler-case <br> (let ((*diagnose-verbose* nil))<br> (let ((return-value (progn ,@@body)))<br> return-value))<br> (error (c)<br> (princ "ERROR! Check Arguments.")<br> (princ (documentation ',name 'function))<br> (print c)<br> (abort))))<br><br>If you wanted to return only the first value, it might be clearer to use<br><br> (values (progn ,@body)) ; values returns as many values as<br> ; arguments it is given, so we see only<br> ; one value is returned here.<br><br>or even:<br><br> (nthh-value 0 (progn ,@body)) ; explicitely return just the first value.<br><br><br>So if I wanted to throw away the other values of the body, I'd write:<br><br> (defmacro do-quietly (name &body body)<br> `(handler-case <br> (let ((*diagnose-verbose* nil))<br> (values (progn ,@@body)))<br> (error (c)<br> (princ "ERROR! Check Arguments.")<br> (princ (documentation ',name 'function))<br> (print c)<br> (abort))))<br><br>but there's really no reason to do it in general, so let's just let body<br>return all its values:<br><br> (defmacro do-quietly (name &body body)<br> `(handler-case <br> (let ((*diagnose-verbose* nil))<br> ,@body)<br> (error (c)<br> (princ "ERROR! Check Arguments.")<br> (princ (documentation ',name 'function))<br> (print c)<br> (abort))))<br><br><br><br>On the other hand, diagnose-verbose could be a symbol macro, in which<br>case you'd have to use #+clisp ext:letf to bind it instead of cl:let, <br>ext:letf expands to something like:<br><br> (let ((saved-value diagnose-verbose))<br> (unwind-protect<br> (progn (setf diagnose-verbose nil)<br> (do-something))<br> (setf diagnose-verbose saved-value)))<br><br>so you'd write something similar:<br><br> (defmacro do-quietly (name &body body)<br> (let ((saved-variable (gensym "SAVED-VALUE-")))<br> `(handler-case <br> (let ((,saved-variable diagnose-verbose))<br> (unwind-protect<br> (progn<br> (setf diagnose-verbose nil)<br> ,@@body)<br> (setf diagnose-verbose ,saved-variable)))<br> (errror (c)<br> (princ "ERROR! Check Arguments.")<br> (princ (documentation ',name 'function))<br> (print c))<br> (abort)))))<br><br><br><br><br><br>It is better to use princ for the condition too, if you want a human<br>readable error message. You could also use format:<br><br> (defmacro do-quietly (name &body body)<br> `(handler-case <br> (let ((*diagnose-verbose* nil))<br> ,@body)<br> (error (err)<br> (format t ""ERROR! Check Arguments. ~&~A~%~A~%"<br> (documentation ',name 'function) err)<br> (abort))))<br><br>Finally, are you sure you want to call ABORT here? This will probably<br>stop the execution of your program, since I doubt yyou installed an ABORT<br>restart. It might be better to not call ABORT, and let the program run<br>other tests. You may also want to enter the debugger to better explore<br>why the form failed, in the context (you'd rather use HANDLER-BIND in<br>this case thought). Or if you just wanted to issue the message, you<br>could also re-signal the error (ERROR ERR), so that the next handler has<br>a chance of handling it too.<br><br><br>-- <br>__Pascal Bourguignon__ <a href="http://www.informatimago.com">http://www.informatimago.com</a>/<br>A bad day in () is better than a good day in {}.<br><br>_______________________________________________<br>Openmcl-devel mailing list<br><a href="mailto:Openmcl-devel@clozure.com">Openmcl-devel@clozure.com</a><br><a href="http://clozure.com/mailman/listinfo/openmcl-devel">http://clozure.com/mailman/listinfo/openmcl-devel</a><br></div></div></span>
</blockquote>
<div>
<br>
</div>
</div>
</div>