Email list hosting service & mailing list manager


Shouldn't cut allow a slot as its first argument? Al Petrofsky 04 Mar 2002 02:02 UTC

It seems to me that the symmetric lisp1 nature of scheme, in which the
evaluation of the operator and operand positions of a procedure call
are identical, calls for cut to allow any of its arguments to be
slots:

  (map (cut <> 7) (list + - (cut - <> 2)))  =>  (7 -7 5)

  (define (run-thunks)
    (for-each (cut <>) the-thunks))

  (define (run-hooks hooks arg)
    (for-each (cut <> arg) hooks))

To effect this change in the BNF spec, change <proc> <const-or-slot>*
to <const-or-slot>+.

Here's a macro that implements this change, plus one-time argument
evaluation, and allows consts after the rest-slot:

(define-syntax cut
  (syntax-rules ()
    ((_ . cut-args)
     (letrec-syntax
         ((find-end
           ;; Reverse the expressions/slots until we find the end or
           ;; the rest-slot.
           (syntax-rules (<...>)
             ((_ rev)               (p #f () ()   () ()             . rev))
             ((_ rev <...>)         (p #t () ()   x  (x)            . rev))
             ((_ rev <...> . exps)  (p #t y  exps x  ((append x y)) . rev))
             ((_ rev exp   . exps)  (find-end (exp . rev) . exps))))
          (p
           ;; p: process the expressions/slots after they have been reversed.
           ;; When finished, form an outer lambda that saves the
           ;; expression results, and an inner lambda that invokes a
           ;; combination, using apply if necessary.
           ;; Called as:  (p need-apply? temps orig-exps slot-names combination
           ;;                expression-or-slot ...)
           (syntax-rules (<>)
             ((_ a  t o s c <> . es) (p a      t       o (x . s) (x . c) . es))
             ((_ a  t o s c e  . es) (p a (y . t) (e . o)     s  (y . c) . es))
             ((_ #t t o s c)         ((lambda t (lambda s (apply . c))) . o))
             ((_ #f t o s c)         ((lambda t (lambda s c)) . o)))))
       (find-end () . cut-args)))))

-al