Groups | Search | Server Info | Login | Register

Groups > comp.lang.scheme > #6556

Re: shootout: implementing an interpreter

Cross-posted to 2 groups.

Show all headers | View raw

> So the product of the sums of the elements of two lists could be
> written using iterate as:
> 
>   (iter (x in xs)
>         (y in ys)
>         (if (= (+ x y) 0) (leave 0))
>         (multiply (+ x y) into z)
>         (finally z))

"!" is similar to "do".

(define (mul-sums xs ys)
  (! (z 1 (* z (+ x y))
      x :in xs
      y :in ys)
    (or (not x) (= 0 z))))

(mul-sums '(2 3 4) '(5 6 7))
  ===>
693

(mul-sums '(2 3 4) '(5 -3 goof))
  ===>
0

Given:

(define-syntax !-aux
  (syntax-rules (<> @  + -  cons cdr  :in :across  :if  ! )
    [(_ (:if bool  z ...) (seen ... (v i u)) stuff ...)
     (!-aux (z ...)
       (seen ... (v i (if bool u v))) stuff ...) ]
    [(_ (x :in lst  z ...) seen (lets ...) stuff ...)
     (!-aux (x (and (pair? xs)(pop! xs)) <>   z ...)
       seen  (lets ... (xs lst))   stuff ...) ]
    [(_ (x :across vec  z ...) seen (lets ...) stuff ...)
     (!-aux (x (and (< i (vector-length v))
                    (begin0 (vector-ref v i) (inc! i))) <>
             z ...)
       seen (lets ... (v vec) (i 0)) stuff ...) ]
    [(_ (a b <>  z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a b b)) stuff ...) ]
    [(_ (a b +  z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a b (+ 1 a))) stuff ...) ]
    [(_ (a + n  z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a 0 (+ n a))) stuff ...) ]
    [(_ (a b -  z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a b (- a 1))) stuff ...) ]
    [(_ (a cons b   z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a '() (cons b a))) stuff ...) ]
    [(_ (a b cdr   z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a b (cdr a))) stuff ...) ]
    [(_ (a b c  z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a b c)) stuff ...) ]
    [(_ (a b) (seen ...) stuff ...)
     (!-aux () (seen ... (a b)) stuff ...) ]
    [(_ (a) (seen ...) stuff ...)
     (!-aux () (seen ... (a '())) stuff ...) ]
    ;;
    [(_ () seen lets   a b c ! action ...)
     (!-aux () seen lets   (a b c) #t (action ...)) ]
    [(_ () seen lets   a b ! action ...)
     (!-aux () seen lets  (a b) #t (action ...)) ]
    [(_ () seen lets  a ! action ...)
     (!-aux () seen lets  a #t (action ...)) ]
    ;;
    [(_ () ((a b c) z ...) lets bool)
     (!-aux () ((a b c) z ...) lets bool a) ]
    [(_ () ((a b c) z ...) lets bool @)
     (!-aux () ((a b c) z ...) lets bool (reverse a)) ]
    [(_ () seen lets bool @ result stuff ...)
     (!-aux () seen lets bool (reverse result) stuff ...) ]
    [(_ () seen lets bool (what @ x z ...) stuff ...)
     (!-aux () seen lets bool (what (reverse x) z ...) stuff ...) ]
    [(_ () seen lets bool (what x @ y z ...) stuff ...)
     (!-aux () seen lets bool (what x (reverse y) z ...) stuff ...) ]
    [(_ () ((a b c) z ...) lets 0 stuff ...)
     (!-aux () ((a b c) z ...) lets (= 0 a) stuff ...) ]
    [(_ () seen lets bool result stuff ...)
     (let lets (do seen (bool result) stuff ...)) ]
  ))
(define-syntax !
  (syntax-rules ()
    [(_ specs bool stuff ...)
     (!-aux specs () () bool stuff ...) ]
  ))

-- 
[T]he problem is that lispniks are as cultish as any other devout group and
basically fall down frothing at the mouth if they see [heterodoxy].
  --- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham

Back to comp.lang.scheme | Previous | Next | Find similar

Thread

Re: shootout: implementing an interpreter "B. Pym" <Nobody447095@here-nor-there.org> - 2025-08-25 11:54 +0000

csiph-web