From: RC
Subject: is there a better way...
Date: 
Message-ID: <1111434641.125096.30470@z14g2000cwz.googlegroups.com>
... or more elegant way to code this in lisp?

here's what I have:

;; Haskell code
;;
;; roots :: (Float, Float, Float) -> (Float, Float)
;; roots (a, b,c) =
;;     if d < 0 then
;;         error "sorry"
;;     else
;;         (x1, x2) where
;;             x1 = e + sqrt d / f
;;             x2 = e - sqrt d / f
;;             d = b * b - 4 * a * c
;;             e = -b / f
;;             f = 2 * a


(defun roots (a b c)
  (let* ((f  #'(lambda () (* 2 a)))
         (d  #'(lambda () (- (* b b) (* 4 a c))))
         (e  #'(lambda () (/ (- b) (funcall f))))
         (x1 #'(lambda () (+ (funcall e) (/ (sqrt (funcall d)) (funcall
f)))))
         (x2 #'(lambda () (- (funcall e) (/ (sqrt (funcall d)) (funcall
f))))))
    (if (< (funcall d) 0)
        (error "sorry")
      (list (funcall x1) (funcall x2)))))

From: Steven E. Harris
Subject: Re: is there a better way...
Date: 
Message-ID: <jk4vf7khhi7.fsf@W003275.na.alarismed.com>
"RC" <·······@bellsouth.net> writes:

> ... or more elegant way to code this in lisp?

Here's one take. The variable names could use some work.


(defun roots (a b c)
  (let ((d (- (expt b 2) (* 4 a c))))
    (when (minusp d)
      (error "sorry"))
    (let ((denom (* 2 a)))
      (flet ((root (e)
               (/ (- e b) denom)))
        (values (root d)
                (root (- d)))))))

-- 
Steven E. Harris
From: Steven E. Harris
Subject: Re: is there a better way...
Date: 
Message-ID: <jk4is3khh9h.fsf@W003275.na.alarismed.com>
"Steven E. Harris" <···@panix.com> writes:

>         (values (root d)
>                 (root (- d)))))))

I forgot to take the sqrt of d.


(defun roots (a b c)
  (let ((d (- (expt b 2) (* 4 a c))))
    (when (minusp d)
      (error "sorry"))
    (let ((denom (* 2 a))
          (ds (sqrt d)))
      (flet ((root (e)
               (/ (- e b) denom)))
        (values (root ds)
                (root (- ds)))))))

-- 
Steven E. Harris
From: Thomas A. Russ
Subject: Re: is there a better way...
Date: 
Message-ID: <ymizmwwy7zs.fsf@sevak.isi.edu>
"RC" <·······@bellsouth.net> writes:

> 
> ... or more elegant way to code this in lisp?
> 
> here's what I have:
> 
> ;; Haskell code
> ;;
> ;; roots :: (Float, Float, Float) -> (Float, Float)
> ;; roots (a, b,c) =
> ;;     if d < 0 then
> ;;         error "sorry"
> ;;     else
> ;;         (x1, x2) where
> ;;             x1 = e + sqrt d / f
> ;;             x2 = e - sqrt d / f
> ;;             d = b * b - 4 * a * c
> ;;             e = -b / f
> ;;             f = 2 * a
> 
> 
> (defun roots (a b c)
>   (let* ((f  #'(lambda () (* 2 a)))
>          (d  #'(lambda () (- (* b b) (* 4 a c))))
>          (e  #'(lambda () (/ (- b) (funcall f))))
>          (x1 #'(lambda () (+ (funcall e) (/ (sqrt (funcall d)) (funcall
> f)))))
>          (x2 #'(lambda () (- (funcall e) (/ (sqrt (funcall d)) (funcall
> f))))))
>     (if (< (funcall d) 0)
>         (error "sorry")
>       (list (funcall x1) (funcall x2)))))
> 

ROTFL



-- 
Thomas A. Russ,  USC/Information Sciences Institute

(I'm assuming this can't be serious....)
From: alex goldman
Subject: Re: is there a better way...
Date: 
Message-ID: <3033252.Tf7BsCYQE1@yahoo.com>
Thomas A. Russ wrote:

>> (defun roots (a b c)
>>(let*�((f��#'(lambda�()�(*�2�a)))
>>(d��#'(lambda�()�(-�(*�b�b)�(*�4�a�c))))
>>(e��#'(lambda�()�(/�(-�b)�(funcall�f))))
>>(x1�#'(lambda�()�(+�(funcall�e)�(/�(sqrt�(funcall�d))�(funcall
>> f)))))
>>(x2�#'(lambda�()�(-�(funcall�e)�(/�(sqrt�(funcall�d))�(funcall
>> f))))))
>>(if�(<�(funcall�d)�0)
>>(error�"sorry")
>>(list�(funcall�x1)�(funcall�x2)))))
>> 
> 
> ROTFL

That's what happens when Haskell is your first language :-)
From: Alan Shutko
Subject: Re: is there a better way...
Date: 
Message-ID: <87br9cjtxa.fsf@vera.springies.com>
alex goldman <·····@spamm.er> writes:

> That's what happens when Haskell is your first language :-)

Well, all those lambdas would duplicate Haskell's lazy evaluation,
though it seems unlikely that's needed here.  

-- 
Alan Shutko <···@acm.org> - I am the rocks.
"Uh, dad? Remember our car?" - Calvin
From: Brian Downing
Subject: Re: is there a better way...
Date: 
Message-ID: <FeY%d.10113$fn3.7022@attbi_s01>
In article <··············@vera.springies.com>,
Alan Shutko  <···@acm.org> wrote:
> alex goldman <·····@spamm.er> writes:
> > That's what happens when Haskell is your first language :-)
> 
> Well, all those lambdas would duplicate Haskell's lazy evaluation,
> though it seems unlikely that's needed here.  

Except (I assume) Haskell would only evaluate a thunk once, whereas some
of his lambdas will be called multiple times (from x1 and x2).

-bcd
-- 
*** Brian Downing <bdowning at lavos dot net> 
From: Hannah Schroeter
Subject: Re: is there a better way...
Date: 
Message-ID: <d1pngq$v5s$1@c3po.use.schlund.de>
Hello!

Brian Downing  <·············@lavos.net> wrote:
>In article <··············@vera.springies.com>,
>Alan Shutko  <···@acm.org> wrote:
>> alex goldman <·····@spamm.er> writes:
>> > That's what happens when Haskell is your first language :-)

>> Well, all those lambdas would duplicate Haskell's lazy evaluation,
>> though it seems unlikely that's needed here.  

>Except (I assume) Haskell would only evaluate a thunk once, whereas some
>of his lambdas will be called multiple times (from x1 and x2).

One solution could be something like this:

(defmacro delay (expr)
  `(cons nil (lambda () ,expr)))

(defun force (value)
  (if (car value)
    (cdr value)
    (let ((v (funcall (cdr value))))
      (setf (car value) t (cdr value) v)
      v)))

Kind regards,

Hannah.
From: RC
Subject: Re: is there a better way...
Date: 
Message-ID: <ebJ0e.54822$6g7.37505@bignews1.bellsouth.net>
······@schlund.de (Hannah Schroeter) wrote in news:d1pngq$v5s$1
@c3po.use.schlund.de:

> Hello!
> 
> Brian Downing  <·············@lavos.net> wrote:
>>In article <··············@vera.springies.com>,
>>Alan Shutko  <···@acm.org> wrote:
>>> alex goldman <·····@spamm.er> writes:
>>> > That's what happens when Haskell is your first language :-)
> 
>>> Well, all those lambdas would duplicate Haskell's lazy evaluation,
>>> though it seems unlikely that's needed here.  
> 
>>Except (I assume) Haskell would only evaluate a thunk once, whereas 
some
>>of his lambdas will be called multiple times (from x1 and x2).
> 
> One solution could be something like this:
> 
> (defmacro delay (expr)
>   `(cons nil (lambda () ,expr)))
> 
> (defun force (value)
>   (if (car value)
>     (cdr value)
>     (let ((v (funcall (cdr value))))
>       (setf (car value) t (cdr value) v)
>       v)))
> 
> Kind regards,
> 
> Hannah.
> 

I took your solution and some of the other
ideas in the thread to try to implement
lazy evaluation but I'm having trouble
with one function (or maybe it should be a macro
I'm not sure):


(defmacro delay (expr)
   `(cons nil (lambda () ,expr)))

(defun force (value)
   (if (car value)
     (cdr value)
     (let ((v (funcall (cdr value))))
       (setf (car value) t (cdr value) v)
       v)))


(defun delayp (lst)
   (and
    (consp lst)
    (or (car lst) (not (car lst)))
    (functionp (cdr lst))))


;; having trouble with this one
;; apply force to delay nodes
(defun haskell (x)
  (if (consp x)
      (let ((elt (car x))
            (lst (cdr x)))
        (if (delayp elt)
            (cons (list 'force elt) (haskell lst))
          (cons elt (haskell lst))))))
          
          
;; modification of macro by Marcos Baringer.
;;
(defmacro in-lazy (form where &rest bindings)
   (declare (ignore where))
   `(let ,(loop for (var = value) on bindings by #'cdddr
                collect (list var `(delay ,value)) into binds
                finally (return (haskell binds)))
      ,(haskell form)))



(defun roots (a b c)
   (in-lazy
    (if (or (zerop a) (minusp d))
        (error "sorry")
      (list x1 x2))
    where
      x1 = (+ e (/ (sqrt d) f))
      x2 = (- e (/ (sqrt d) f))
      d  = (- (* b b) (* 4 a c))
      e  = (/ (- b) f)
      f  = (* 2 a)))
From: Harald Hanche-Olsen
Subject: Re: is there a better way...
Date: 
Message-ID: <pcoeke42hf2.fsf@shuttle.math.ntnu.no>
+ RC <········@this.place>:

| (defmacro delay (expr)
|    `(cons nil (lambda () ,expr)))
| 
| (defun force (value)
|    (if (car value)
|      (cdr value)
|      (let ((v (funcall (cdr value))))
|        (setf (car value) t (cdr value) v)
|        v)))
| 
| (defun delayp (lst)
|    (and
|     (consp lst)
|     (or (car lst) (not (car lst)))
|     (functionp (cdr lst))))

Seems dangerous to me to assume that nothing but a "delay" (which I
think is more approprately called a promise) has this particular
form.  Also, (or (car lst) (not (car lst))) is always true.

You really need a new type, and the best way (?) to do this is with a
CLOS class.  Here is a stab:

(defclass promise ()
  ((forced :reader forcedp :initform nil)
   (value)
   (forcer :initarg :forcer)))

(defmethod force ((promise promise))
  (if (forcedp promise)
      (slot-value promise 'value)
      (prog1
	  (setf (slot-value promise 'value)
		(funcall (slot-value promise 'forcer)))
	(setf (slot-value promise 'forced) t))))

(defmacro delay (&body body)
  `(make-instance 'promise :forcer (lambda () ,@body)))

(defun promisep (object) (typep object 'promise))

| ;; having trouble with this one
| ;; apply force to delay nodes
| (defun haskell (x)
|   (if (consp x)
|       (let ((elt (car x))
|             (lst (cdr x)))
|         (if (delayp elt)
|             (cons (list 'force elt) (haskell lst))
|           (cons elt (haskell lst))))))

Could your trouble be related to the fact that the if has no "else"
branch?  (I didn't try to read the rest of your code, so take all this
with a grain of salt.)

-- 
* Harald Hanche-Olsen     <URL:http://www.math.ntnu.no/~hanche/>
- Debating gives most of us much more psychological satisfaction
  than thinking does: but it deprives us of whatever chance there is
  of getting closer to the truth.  -- C.P. Snow
From: Fred Gilham
Subject: Re: is there a better way...
Date: 
Message-ID: <u7ll8bzh96.fsf@snapdragon.csl.sri.com>
Harald Hanche-Olsen wrote:
> Also, (or (car lst) (not (car lst))) is always true.

It's an ugly hack but it's not always true:

(setf *foo* (list 1 2 3))
(setf *bar* nil)

(or (car *foo*) (not (car *foo*)))
1

(or (car *bar*) (not (car *bar*)))
T

-- 
Fred Gilham                                        ······@csl.sri.com
Thou shalt not convince stupid people to try cordless bungee jumping....
Thou shalt not substitute Semtex when all the Playdough's gone....
Thou shalt not bob for hand grenades....
From: Brian Downing
Subject: Re: is there a better way...
Date: 
Message-ID: <rOZ0e.2848$NW5.2463@attbi_s02>
In article <··············@snapdragon.csl.sri.com>,
Fred Gilham  <······@snapdragon.csl.sri.com> wrote:
> Harald Hanche-Olsen wrote:
> > Also, (or (car lst) (not (car lst))) is always true.
> 
> It's an ugly hack but it's not always true:
> 
> (setf *foo* (list 1 2 3))
> (setf *bar* nil)
> 
> (or (car *foo*) (not (car *foo*)))
> 1
> 
> (or (car *bar*) (not (car *bar*)))
> T

Those are both true...

-bcd
-- 
*** Brian Downing <bdowning at lavos dot net> 
From: RC
Subject: Re: is there a better way...
Date: 
Message-ID: <8GZ0e.65041$Q83.32792@bignews5.bellsouth.net>
Harald Hanche-Olsen <······@math.ntnu.no> wrote in 
····················@shuttle.math.ntnu.no:

> + RC <········@this.place>:
> 
>| (defmacro delay (expr)
>|    `(cons nil (lambda () ,expr)))
>| 
>| (defun force (value)
>|    (if (car value)
>|      (cdr value)
>|      (let ((v (funcall (cdr value))))
>|        (setf (car value) t (cdr value) v)
>|        v)))
>| 
>| (defun delayp (lst)
>|    (and
>|     (consp lst)
>|     (or (car lst) (not (car lst)))
>|     (functionp (cdr lst))))
> 
> Seems dangerous to me to assume that nothing but a "delay" (which I
> think is more approprately called a promise) has this particular
> form.  Also, (or (car lst) (not (car lst))) is always true.


Yes, true.

my intent was along the lines of:


(defun delayp (lst)
   (and
    (consp lst)
    (or 
     (and
      (typep (car lst) 'null)
      (functionp (cdr lst)))
     (and
      (typep (car lst) 'symbol)
      (typep (cdr lst) 'fixnum)))))
From: Harald Hanche-Olsen
Subject: Re: is there a better way...
Date: 
Message-ID: <pcoacos2hbc.fsf@shuttle.math.ntnu.no>
+ RC <········@this.place>:

| (defmacro delay (expr)
|    `(cons nil (lambda () ,expr)))
| 
| (defun force (value)
|    (if (car value)
|      (cdr value)
|      (let ((v (funcall (cdr value))))
|        (setf (car value) t (cdr value) v)
|        v)))
| 
| (defun delayp (lst)
|    (and
|     (consp lst)
|     (or (car lst) (not (car lst)))
|     (functionp (cdr lst))))

Seems dangerous to me to assume that nothing but a "delay" (which I
think is more approprately called a promise) has this particular
form.  Also, (or (car lst) (not (car lst))) is always true.

You really need a new type, and the best way (?) to do this is with a
CLOS class.  Here is a stab:

(defclass promise ()
  ((forced :reader forcedp :initform nil)
   (value)
   (forcer :initarg :forcer)))

(defmethod force ((promise promise))
  (if (forcedp promise)
      (slot-value promise 'value)
      (prog1
	  (setf (slot-value promise 'value)
		(funcall (slot-value promise 'forcer)))
	(setf (slot-value promise 'forced) t))))

(defmethod force ((promise t)) promise)

(defmacro delay (&body body)
  `(make-instance 'promise :forcer (lambda () ,@body)))

(defun promisep (object) (typep object 'promise))

| ;; having trouble with this one
| ;; apply force to delay nodes
| (defun haskell (x)
|   (if (consp x)
|       (let ((elt (car x))
|             (lst (cdr x)))
|         (if (delayp elt)
|             (cons (list 'force elt) (haskell lst))
|           (cons elt (haskell lst))))))

Could your trouble be related to the fact that the if has no "else"
branch?  (I didn't try to read the rest of your code, so take all this
with a grain of salt.)

-- 
* Harald Hanche-Olsen     <URL:http://www.math.ntnu.no/~hanche/>
- Debating gives most of us much more psychological satisfaction
  than thinking does: but it deprives us of whatever chance there is
  of getting closer to the truth.  -- C.P. Snow
From: Brian Downing
Subject: Re: is there a better way...
Date: 
Message-ID: <VAX0e.2620$NW5.1140@attbi_s02>
In article <·····················@bignews1.bellsouth.net>,
RC  <········@this.place> wrote:
> I took your solution and some of the other
> ideas in the thread to try to implement
> lazy evaluation but I'm having trouble
> with one function (or maybe it should be a macro
> I'm not sure):

[...]

> ;; having trouble with this one
> ;; apply force to delay nodes
> (defun haskell (x)
>   (if (consp x)
>       (let ((elt (car x))
>             (lst (cdr x)))
>         (if (delayp elt)
>             (cons (list 'force elt) (haskell lst))
>           (cons elt (haskell lst))))))
>           
> ;; modification of macro by Marcos Baringer.
> ;;
> (defmacro in-lazy (form where &rest bindings)
>    (declare (ignore where))
>    `(let ,(loop for (var = value) on bindings by #'cdddr
>                 collect (list var `(delay ,value)) into binds
>                 finally (return (haskell binds)))
>       ,(haskell form)))

Tracing HASKELL should provide a clue as to what's wrong here:

  0: (DELAYP (X1 (DELAY #)))
  0: DELAYP returned NIL
  0: (DELAYP (X2 (DELAY #)))
  0: DELAYP returned NIL
  0: (DELAYP (D (DELAY #)))
  0: DELAYP returned NIL
  0: (DELAYP (E (DELAY #)))
  0: DELAYP returned NIL
  0: (DELAYP (F (DELAY #)))
  0: DELAYP returned NIL
  0: (DELAYP IF)
  0: DELAYP returned NIL
  0: (DELAYP (OR (ZEROP A) (MINUSP D)))
  0: DELAYP returned NIL
  0: (DELAYP (ERROR "sorry"))
  0: DELAYP returned NIL
  0: (DELAYP (LIST X1 X2))
  0: DELAYP returned NIL

You're calling DELAYP on the original forms.  You're working with source
code here, so you want to identify what to force based on the name.
This is going to require something like a code walker.  Fortunately,
Common Lisp lets us hook into its own in a way:

(defmacro in-lazy (form where &rest bindings)
  (declare (ignore where))
  (multiple-value-bind (bindings thunk-names thunks forces)
      (loop for (var = val) on bindings by #'cdddr
            for thunk-name =
                (gensym (concatenate 'string (symbol-name var) "-THUNK-"))
            collect var into vars
            collect thunk-name into thunk-names
            collect `(delay ,val) into thunks
            collect `(force ,thunk-name) into forces
            finally (return (values vars thunk-names thunks forces)))
    `(let ,thunk-names
       (symbol-macrolet ,(funcall #'mapcar #'list bindings forces)
         ,@(loop for thunk-name in thunk-names and thunk in thunks
                 collect `(setf ,thunk-name ,thunk))
         ,form))))

This works as such:

CL-USER> (macroexpand-1 
          '(in-lazy
            (if (or (zerop a) (minusp d))
                (error "sorry")
                (list x1 x2))
            where
              x1 = (+ e (/ (sqrt d) f))
              x2 = (- e (/ (sqrt d) f))
              d  = (- (* b b) (* 4 a c))
              e  = (/ (- b) f)
              f  = (* 2 a)))
(LET (#:X1-THUNK-1183
      #:X2-THUNK-1184
      #:D-THUNK-1185
      #:E-THUNK-1186
      #:F-THUNK-1187)
  (SYMBOL-MACROLET ((X1 (FORCE #:X1-THUNK-1183))
                    (X2 (FORCE #:X2-THUNK-1184))
                    (D (FORCE #:D-THUNK-1185))
                    (E (FORCE #:E-THUNK-1186))
                    (F (FORCE #:F-THUNK-1187)))
    (SETF #:X1-THUNK-1183 (DELAY (+ E (/ (SQRT D) F))))
    (SETF #:X2-THUNK-1184 (DELAY (- E (/ (SQRT D) F))))
    (SETF #:D-THUNK-1185 (DELAY (- (* B B) (* 4 A C))))
    (SETF #:E-THUNK-1186 (DELAY (/ (- B) F)))
    (SETF #:F-THUNK-1187 (DELAY (* 2 A)))
    (IF (OR (ZEROP A) (MINUSP D)) (ERROR "sorry") (LIST X1 X2))))

(I'm assuming your syntax is mutually recursive, like LABELS or Scheme's
letrec.  If not, and you want to be able to use outside bindings, you
could produce an ugly deep nested structure instead.)

-bcd
-- 
*** Brian Downing <bdowning at lavos dot net> 
From: Brian Downing
Subject: Re: is there a better way...
Date: 
Message-ID: <eIX0e.2627$NW5.1196@attbi_s02>
In article <···················@attbi_s02>,
Brian Downing  <·············@lavos.net> wrote:
> (funcall #'mapcar #'list bindings forces)

Obviously this should just be (mapcar #'list bindings forces).

(This was leftover braindamage from implementing this in general
as (lambda (&rest lists) (apply #'mapcar #'list lists))).

-bcd
-- 
*** Brian Downing <bdowning at lavos dot net> 
From: RC
Subject: Re: is there a better way...
Date: 
Message-ID: <xkm1e.74446$5T6.35153@bignews4.bellsouth.net>
Brian Downing <·············@lavos.net> wrote in
························@attbi_s02: 

> In article <·····················@bignews1.bellsouth.net>,
> RC  <········@this.place> wrote:
>> I took your solution and some of the other
>> ideas in the thread to try to implement
>> lazy evaluation but I'm having trouble
>> with one function (or maybe it should be a macro
>> I'm not sure):
> 
> [...]
> 
>> ;; having trouble with this one
>> ;; apply force to delay nodes
>> (defun haskell (x)
>>   (if (consp x)
>>       (let ((elt (car x))
>>             (lst (cdr x)))
>>         (if (delayp elt)
>>             (cons (list 'force elt) (haskell lst))
>>           (cons elt (haskell lst))))))
>>           
>> ;; modification of macro by Marcos Baringer.
>> ;;
>> (defmacro in-lazy (form where &rest bindings)
>>    (declare (ignore where))
>>    `(let ,(loop for (var = value) on bindings by #'cdddr
>>                 collect (list var `(delay ,value)) into binds
>>                 finally (return (haskell binds)))
>>       ,(haskell form)))
> 
> Tracing HASKELL should provide a clue as to what's wrong here:
> 
>   0: (DELAYP (X1 (DELAY #)))
>   0: DELAYP returned NIL
>   0: (DELAYP (X2 (DELAY #)))
>   0: DELAYP returned NIL
>   0: (DELAYP (D (DELAY #)))
>   0: DELAYP returned NIL
>   0: (DELAYP (E (DELAY #)))
>   0: DELAYP returned NIL
>   0: (DELAYP (F (DELAY #)))
>   0: DELAYP returned NIL
>   0: (DELAYP IF)
>   0: DELAYP returned NIL
>   0: (DELAYP (OR (ZEROP A) (MINUSP D)))
>   0: DELAYP returned NIL
>   0: (DELAYP (ERROR "sorry"))
>   0: DELAYP returned NIL
>   0: (DELAYP (LIST X1 X2))
>   0: DELAYP returned NIL
> 
> You're calling DELAYP on the original forms.  You're working with
> source code here, so you want to identify what to force based on the
> name. 

yes!

At the time you mentioned this I was thinking I need some
kind of symbol table and was working with that in mind.
Your solution helped me complete it in a slightly different way
since I was having a lot of difficulty with the language
of LOOP and macros.

This is going to require something like a code walker. 
> Fortunately, Common Lisp lets us hook into its own in a way:
> 
> (defmacro in-lazy (form where &rest bindings)
>   (declare (ignore where))
>   (multiple-value-bind (bindings thunk-names thunks forces)
>       (loop for (var = val) on bindings by #'cdddr
>             for thunk-name =
>                 (gensym (concatenate 'string (symbol-name var)
>                 "-THUNK-")) 
>             collect var into vars
>             collect thunk-name into thunk-names
>             collect `(delay ,val) into thunks
>             collect `(force ,thunk-name) into forces
>             finally (return (values vars thunk-names thunks forces)))
>     `(let ,thunk-names
>        (symbol-macrolet ,(funcall #'mapcar #'list bindings forces)
>          ,@(loop for thunk-name in thunk-names and thunk in thunks
>                  collect `(setf ,thunk-name ,thunk))
>          ,form))))
> 
> This works as such:
> 
> CL-USER> (macroexpand-1 
>           '(in-lazy
>             (if (or (zerop a) (minusp d))
>                 (error "sorry")
>                 (list x1 x2))
>             where
>               x1 = (+ e (/ (sqrt d) f))
>               x2 = (- e (/ (sqrt d) f))
>               d  = (- (* b b) (* 4 a c))
>               e  = (/ (- b) f)
>               f  = (* 2 a)))
> (LET (#:X1-THUNK-1183
>       #:X2-THUNK-1184
>       #:D-THUNK-1185
>       #:E-THUNK-1186
>       #:F-THUNK-1187)
>   (SYMBOL-MACROLET ((X1 (FORCE #:X1-THUNK-1183))
>                     (X2 (FORCE #:X2-THUNK-1184))
>                     (D (FORCE #:D-THUNK-1185))
>                     (E (FORCE #:E-THUNK-1186))
>                     (F (FORCE #:F-THUNK-1187)))
>     (SETF #:X1-THUNK-1183 (DELAY (+ E (/ (SQRT D) F))))
>     (SETF #:X2-THUNK-1184 (DELAY (- E (/ (SQRT D) F))))
>     (SETF #:D-THUNK-1185 (DELAY (- (* B B) (* 4 A C))))
>     (SETF #:E-THUNK-1186 (DELAY (/ (- B) F)))
>     (SETF #:F-THUNK-1187 (DELAY (* 2 A)))
>     (IF (OR (ZEROP A) (MINUSP D)) (ERROR "sorry") (LIST X1 X2))))
> 
> (I'm assuming your syntax is mutually recursive, like LABELS or
> Scheme's letrec.  If not, and you want to be able to use outside
> bindings, you could produce an ugly deep nested structure instead.)
> 
> -bcd


Here's what i have fwiw:

(defun apply-force (x symbol-table)
  (if (null x)
      nil
    (if (atom x)
        (if (member x symbol-table) 
            (list 'force x)
          x)
      (let ((elt (car x))
            (lst (cdr x)))
        (cons
         (apply-force elt symbol-table)
         (apply-force lst symbol-table))))))

(defmacro in-lazy2 (form where &rest bindings)
  (declare (ignore where))
  (multiple-value-bind (lvalues rvalues)
      (loop for (lhs = rhs) on bindings by #'cdddr
               collect lhs into lvalues
               collect `(delay ,rhs) into rvalues
               finally (return (values lvalues rvalues)))
    `(let ,lvalues
       ,@(mapcar #'(lambda (lhs rhs) `(setf ,lhs ,rhs))
                lvalues (apply-force rvalues lvalues))
       ,(apply-force form lvalues))))


... and the output of macroexpand:

(LET (X1 X2 D E F) 
  (SETF X1 (DELAY (+ (FORCE E) (/ (SQRT (FORCE D)) (FORCE F))))) 
  (SETF X2 (DELAY (- (FORCE E) (/ (SQRT (FORCE D)) (FORCE F))))) 
  (SETF D (DELAY (- (* B B) (* 4 A C)))) 
  (SETF E (DELAY (/ (- B) (FORCE F)))) 
  (SETF F (DELAY (* 2 A))) 
  (IF (OR (ZEROP A) (MINUSP (FORCE D))) 
      (ERROR "sorry") 
    (LIST (FORCE X1) (FORCE X2))))


Seems to work for this example.
Thanks to everyone for all the help.
From: Brian Downing
Subject: Re: is there a better way...
Date: 
Message-ID: <WYo1e.22704$fn3.21210@attbi_s01>
In article <·····················@bignews4.bellsouth.net>,
RC  <········@this.place> wrote:
> > You're calling DELAYP on the original forms.  You're working with
> > source code here, so you want to identify what to force based on the
> > name. 
> 
> yes!
> 
> At the time you mentioned this I was thinking I need some
> kind of symbol table and was working with that in mind.
> Your solution helped me complete it in a slightly different way
> since I was having a lot of difficulty with the language
> of LOOP and macros.
> 
> > This is going to require something like a code walker. 
> > Fortunately, Common Lisp lets us hook into its own in a way:
> > 
> > [using SYMBOL-MACROLET]
> 
> Here's what i have fwiw:
> 
> [simple name substitution]
> 
> Seems to work for this example.
> Thanks to everyone for all the help.

You're on the right track, but your solution doesn't work for all cases.
The reason I mentioned needing a code walker is because of this example:

(in-lazy2
 (if (or (zerop a) (minusp d))
     (error "sorry")
     (list if or))
 where
   if = (+ e (/ (sqrt d) f))
   or = (- e (/ (sqrt d) f))
   d  = (- (* b b) (* 4 a c))
   e  = (/ (- b) f)
   f  = (* 2 a))
=> While compiling an anonymous function :
   (FORCE IF) is not a symbol or lambda expression

This is because it macroexpanded to:

(LET (IF OR D E F)
  (SETF IF (DELAY (+ (FORCE E) (/ (SQRT (FORCE D)) (FORCE F)))))
  (SETF OR (DELAY (- (FORCE E) (/ (SQRT (FORCE D)) (FORCE F)))))
  (SETF D (DELAY (- (* B B) (* 4 A C))))
  (SETF E (DELAY (/ (- B) (FORCE F))))
  (SETF F (DELAY (* 2 A)))
  ((FORCE IF) ((FORCE OR) (ZEROP A) (MINUSP (FORCE D))) (ERROR "sorry")
   (LIST (FORCE IF) (FORCE OR))))

By using SYMBOL-MACROLET (as I did in my example) you can take advantage
of the fact that CL knows when to macroexpand for a normal evaluation of
a symbol, but not for CARs of forms, macro arguments, and some special
operator arguments.  Also, SYMBOL-MACROLETs has lexical scope, so if for
instance you had:

(in-lazy
 (format nil "~A ~A~%"
         hello-world
         (let ((hello-world "Good bye!"))
           hello-world))
 where
   hello-world = "Hello, world!")

It would return "Hello, world! Good bye!" as expected.

-bcd
-- 
*** Brian Downing <bdowning at lavos dot net> 
From: RC
Subject: Re: is there a better way...
Date: 
Message-ID: <VoL%d.38870$6g7.34692@bignews1.bellsouth.net>
alex goldman <·····@spamm.er> wrote in ·······················@yahoo.com:

> Thomas A. Russ wrote:
> 
>>> (defun roots (a b c)
>>>(let*�((f��#'(lambda�()�(*�2�a)))
>>>(d��#'(lambda�()�(-�(*�b�b)�(*�4�a�c))))
>>>(e��#'(lambda�()�(/�(-�b)�(funcall�f))))
>>>(x1�#'(lambda�()�(+�(funcall�e)�(/�(sqrt�(funcall�d))�(funcall
>>> f)))))
>>>(x2�#'(lambda�()�(-�(funcall�e)�(/�(sqrt�(funcall�d))�(funcall
>>> f))))))
>>>(if�(<�(funcall�d)�0)
>>>(error�"sorry")
>>>(list�(funcall�x1)�(funcall�x2)))))
>>> 
>> 
>> ROTFL
> 
> That's what happens when Haskell is your first language :-)

well, actually happens when you don't know
any of these functional languages. :)

Anyway, thank you for all the responses.
They are all very interesting and unique.

I was looking for a solution that would
resemble the functional expressions of Haskell
rather than what seems like an assignment when
using something like (let ((f (* 2 a)...

If I understand correctly, f = 2 * a, is 
functional expression and not an assignment?
From: alex goldman
Subject: Re: is there a better way...
Date: 
Message-ID: <1612264.l6RpRjV0JK@yahoo.com>
RC wrote:

> I was looking for a solution that would
> resemble the functional expressions of Haskell
> rather than what seems like an assignment when
> using something like (let ((f (* 2 a)...
> 
> If I understand correctly, f = 2 * a, is
> functional expression and not an assignment?

It's a binding. The difference between doing 'let' in Haskell and Lisp is
that it's lazy in the former, i.e. the computation will happen only when
needed. 

You faithfully, but unnecessarily, reproduced this laziness in Lisp with
those LAMBDAs.
From: Artie Gold
Subject: Re: is there a better way...
Date: 
Message-ID: <3a9g96F6bl8l0U1@individual.net>
alex goldman wrote:
> RC wrote:
> 
> 
>>I was looking for a solution that would
>>resemble the functional expressions of Haskell
>>rather than what seems like an assignment when
>>using something like (let ((f (* 2 a)...
>>
>>If I understand correctly, f = 2 * a, is
>>functional expression and not an assignment?
> 
> 
> It's a binding. The difference between doing 'let' in Haskell and Lisp is
> that it's lazy in the former, i.e. the computation will happen only when
> needed. 
> 
> You faithfully, but unnecessarily, reproduced this laziness in Lisp with
> those LAMBDAs.

Well, modulo the CSE anyway...

--ag

-- 
Artie Gold -- Austin, Texas
http://it-matters.blogspot.com (new post 12/5)
http://www.cafepress.com/goldsays
From: jayessay
Subject: Re: is there a better way...
Date: 
Message-ID: <m3br9csq0h.fsf@rigel.goldenthreadtech.com>
"RC" <·······@bellsouth.net> writes:

> ... or more elegant way to code this in lisp?
> 

Untested.

(defun roots (a b c)
  (if (= a 0)
      (error "a can't be 0)
      (let ((sqrt-b2-4ac (sqrt (- (* b b) (* 4 a c))))
            (2a (* 2 a))
            (-b (- b)))
        (values (/ (+ -b sqrt-b2-4ac) 2a)
                (/ (- -b sqrt-b2-4ac) 2a)))))

BTW, why did you think you needed all those lambdas????


/Jon

-- 
'j' - a n t h o n y at romeo/charley/november com
From: Alan Crowe
Subject: Re: is there a better way...
Date: 
Message-ID: <86u0n4u2ox.fsf@cawtech.freeserve.co.uk>
RC asked:
> ... or more elegant way to code this in lisp?
>
>here's what I have:
>
> ;; Haskell code
> ;;
<snip>
> (defun roots (a b c)
>   (let* ((f  #'(lambda () (* 2 a)))
>          (d  #'(lambda () (- (* b b) (* 4 a c))))
etc.

You give no overview. What are you trying to? If you are
trying to solve quadratics you need to watch out for
cancellation error when A is small.

Play with this code to see the problem, and an attempt to
solve it even when a,b and c are complex.

;;; I want to make sure that I can demonstrate
;;; the problem, before I declare that I have solved
;;; it.
(defun bad-quadratic-solver (a b c)
  (let ((discriminant (sqrt (- (expt b 2)
                               (* 4 a c)))))
    (values (/ (+ (- b) discriminant)
               (* 2 a))
            (/ (- (- b) discriminant)
               (* 2 a)))))

(defun problem-demo(&optional (n 10)
                              (solver 'bad-quadratic-solver))
  (dotimes (i n)
    (let ((a (expt 10 (- i)))
          (b -3)
          (c 2))
      (format t "~&Solutions of ~Ax^2 ·@Fx ·@F are:"
              a b c)
      (format t "~&  ~{~F  ~}~%~%"
              (multiple-value-list
               (funcall solver a b c))))))

;;; Handling small a
;;; There are two square roots of b^2-4ac
;;; one will be closer in phase to b than the other
;;; The one that is furthest in phase goes
;;; into the formula (-b+d)/2a
;;; The other goes into 2c/(-b-d)
(defun solve-quadratic (a b c)
  (let* ((closer (sqrt (- (expt b 2)
                      (* 4 a c))))
         (further (- closer)))
    (if (< (abs (- (phase b)
                   (phase further)))
           (abs (- (phase b)
                   (phase closer))))
        (rotatef closer further))
    (values (/ (+ (- b) further)
               (* 2 a))
            (/ (* 2 c)
               (- (- b) closer)))))

Alan Crowe
Edinburgh
Scotland
From: Marco Baringer
Subject: Re: is there a better way...
Date: 
Message-ID: <m2is3koj25.fsf@soma.local>
"RC" <·······@bellsouth.net> writes:

> (defun roots (a b c)
>   (let* ((f  #'(lambda () (* 2 a)))
>          (d  #'(lambda () (- (* b b) (* 4 a c))))
>          (e  #'(lambda () (/ (- b) (funcall f))))
>          (x1 #'(lambda () (+ (funcall e) (/ (sqrt (funcall d)) (funcall
> f)))))
>          (x2 #'(lambda () (- (funcall e) (/ (sqrt (funcall d)) (funcall
> f))))))
>     (if (< (funcall d) 0)
>         (error "sorry")
>       (list (funcall x1) (funcall x2)))))

why, why, why all the lambdas!?!? why not just translate the haskell code
literally?

(defun roots (a b c)
  (let* ((f (* 2 a))
         (e (/ (- b) f))
         (d (- (* b b) (* 4 a c))))
    (if (< d 0)
        (error "sorry")
        (values (+ e (/ (sqrt d) f))
                (- e (/ (sqrt d) f))))))

of course, this is a place where infix wolud be helpfull:

(defun roots (a b c)
  (let* ((f #I(2 * a))
         (e #I(-b / f))
         (d #I(b^^2 - 4 * a *c)))
    (when (< d 0)
      (error "sorry"))
    (values #I( e + sqrt(d) / f)
            #I( e - sqrt(d) / f))))

i don't know what you need this for, but i'd just let it return a
complex and worry about it later:

(defun roots (a b c)
  (let ((e          #I( -b / (2 * a) ))
        (d #I(sqrt(b ^^ 2 - 4 * a * c) / (2 * a))))
    (values #I(e + d) #I(e - d))))

just for fun [and i don't suggest this], here's a more or less literal
translation of the haskell:

(defmacro in (form where &rest bindings)
  (declare (ignore where))
  `(let ,(loop for (var = value) on bindings by #'cdddr
               collect (list var value) into binds
               finally (return (nreverse binds)))
     ,form))

(defun roots (a b c)
  (in
      (if (minusp d)
          (error "sorry")
          (values x1 x2))
    where
      x1 = #I(e + sqrt(d) / f)
      x2 = #I(e - sqrt(d) / f)
      d  = #I(b ^^ 2 - 4 * a * c)
      e  = #I(-b / f)
      f  = #I(2 * a)))
       
-- 
-Marco
Ring the bells that still can ring.
Forget the perfect offering.
There is a crack in everything.
That's how the light gets in.
	-Leonard Cohen