Overwrite * and + to work like in Python

[jcubic]

Someone askes on /r/lisp Sub Reddit: Python's approach is much better {{{ x= ( 10 * [a] ) }}} because i don't have to remember the (ad-hoc) name of the function.

I think it would be fun to create code that will make Scheme work like Python. examples of python code:

[1] * 2 * 4 * 5
2 * [2] * 3 * 3
"x" * 2 * 3
10 * "x" * 10 * 2

you can put sequence (here list or string) and use multiplication to make the sequence larger. And + works by concatenation of the sequences.

Here is my quick code for two arguments:

(define * (let ((mul *))
            (lambda args
              (if (= (length args) 2)
                  (let ((first (car args))
                        (second (cadr args)))
                    (cond ((and (list? first) (integer? second))
                           (apply append (make-list second first)))
                          ((and (list? second) (integer? first))
                           (apply append (make-list first second)))
                          (else
                           (apply mul args))))
                  (apply mul args)))))

scheme> (* '(1 2) 10)
;; ==> (1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2)
scheme> (* 1 2)
;; ==> 2

I think it would be a nice exercise to make * work exactly like in Python with lists, vectors, and strings. and It would be a good example that will show that Scheme is more powerful than python because you can do exactly the same what python have in Scheme but not other way around.

What do you think about including a recipe something like "Python * and + in Scheme" or something similar?

NOTE: if you don't like overwriting builtins it was used by Gerrald Sussman in his talk We Really Don't Know How to Compute! from 2011 Strange Loop.

[lassik]

What do you think about including a recipe something like "Python * and + in Scheme" or something similar?

It's a good idea to include in the cookbook!

In the standard language, the Lisp family (Scheme, CL, ELisp, Clojure) and other functional language have not made * append strings and lists, because appending sequences doesn't have the same mathematical properties as multiplying numbers. Most importantly, + and * are commutative on numbers (as in math), whereas append is not commutative. (https://www.mathsisfun.com/associative-commutative-distributive.html)

(define (commutative? operator a b)
  (equal? (operator a b)
          (operator b a)))

(define (associative? operator a b c)
  (equal? (operator a (operator b c))
          (operator (operator a b) c)))

(commutative? + 2 3)                         ; => #t
(associative? + 2 3 4)                       ; => #t

(commutative? * 2 3)                         ; => #t
(associative? * 2 3 4)                       ; => #t

(commutative? append '(a b) '(c d))          ; => #f (NOTE)
(associative? append '(a b) '(c d) '(e f))   ; => #t

(commutative? string-append "ab" "cd")       ; => #f (NOTE)
(associative? string-append "ab" "cd" "ef")  ; => #t

;; This follows the normal rules of math, `-` and `/` are neither commutative nor associative:

(commutative? - 2 3)                         ; => #f
(associative? - 2 3 4)                       ; => #f

(commutative? / 2 3)                         ; => #f
(associative? / 2 3 4)                       ; => #f

BTW in Python 3, even the generic * can be repeated many times:

>>> [1,2] * 2
[1, 2, 1, 2]
>>> [1,2] * 2 * 2
[1, 2, 1, 2, 1, 2, 1, 2]
>>> [1,2] * 2 * 2 * 2
[1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2]

[lassik]

However, sequence * number is commutative and associative in Python:

>>> "a" * 2
'aa'
>>> 2 * "a"
'aa'

>>> "a" * (2 * 3)
'aaaaaa'
>>> ("a" * 2) * 3
'aaaaaa'

So * could make mathematical sense to override.

[jcubic]

I was thinking maybe it will be possible to have something even more generic. To overwrite * and + and allow the user to specify the left and right type using some generic API. With example how to add string, vector and list to the mix. And if user try to combine string with list he can but can also raise an error. It will be left to the user.

Maybe something like:

(define +-dispatch-table (let ((plus +))
                           (list (cons '(pair string) (lambda (a b)
                                                        (append a (string->list b))))
                                 (cons '(string pair) (lambda (a b)
                                                        (append (string->list a) pair)))
                                 (cons '(string string) string-append)
                                 (cons '(pair pair) append)
                                 (cons '(number number) plus))))

(cond-expand
 (chicken
  (import (r7rs) srfi-1 srfi-28))
 (guile
  (use-modules (srfi srfi-1))))

(cond-expand
 (lips)
 (else
  (define (print x)
    (display x)
    (newline))))

;; type-of recipe
(cond-expand
 (r7rs
  (define type-of-alist-extra (list (cons bytevector? 'bytevector))))
 (else
  (define type-of-alist-extra '())))

(define type-of-alist
  (append type-of-alist-extra
          (list (cons boolean?    'boolean)
                (cons char?       'char)
                (cons eof-object? 'eof-object)
                (cons null?       'null)
                (cons number?     'number)
                (cons pair?       'pair)
                (cons port?       'port)
                (cons procedure?  'procedure)
                (cons string?     'string)
                (cons symbol?     'symbol)
                (cons vector?     'vector))))

(define (type-of obj)
  (let loop ((alist type-of-alist))
    (and (not (null? alist))
         (if ((caar alist) obj) (cdar alist) (loop (cdr alist))))))

(define (dispatch table a b)
  (let* ((a_type (type-of a))
         (b_type (type-of b))
         (item (find (lambda (pair)
                       (let ((types (car pair)))
                         (and (symbol=? a_type (car types))
                            (symbol=? b_type (cadr types)))))
                     table)))
    (if (null? item)
        (error (format "Invalid type ~a and ~a" a_type b_type))
        ((cdr item) a b))))

(define + (lambda args
            (fold-right (lambda (a b)
                          (if (null? b)
                              a
                              (dispatch +-dispatch-table a b)))
                        '()
                        args)))

(print (+ 1 2 3 4 5))
(print (+ "hello" "world"))
(print (+ '(1 2) '(3 4)))

[lassik]

Good work.

Most people in Lisp communities will probably expect * and + to be commutative. Then the dispatcher can also take advantage of the fact that it can swap the order of the left and right arguments to the operator, so the user doesn't have to specify (pair string) and (string pair) separately.

Proof of concept:

(import (scheme base) (scheme case-lambda) (scheme write))

(define (identity x) x)

(define (repeater make-empty append)
  (lambda (n part)
    (let loop ((n n) (whole (make-empty)))
      (if (<= n 0) whole (loop (- n 1) (append whole part))))))

(define (commutative-case type-a? type-b? operator next-case)
  (lambda (a b)
    (cond ((type-a? a)
           ((if (type-b? b) operator next-case) a b))
          ((type-b? a)
           ((if (type-a? b) operator next-case) b a))
          (else
           (next-case a b)))))

(define (commutative-case-no-match operator-name)
  (lambda (a b)
    (error "No match for" operator-name a b)))

(define (commutative-operator case-0 case-1 case-2)
  (case-lambda
    (()
     case-0)
    ((a)
     (case-1 a))
    ((a b)
     (case-2 a b))
    ((a b . rest)
     (let loop ((result (case-2 a b)) (rest rest))
       (if (null? rest) result
           (loop (case-2 result (car rest)) (cdr rest)))))))

(define dispatch*
  (commutative-case
   number? number? *
   (commutative-case
    integer? list? (repeater list append)
    (commutative-case
     integer? vector? (repeater vector vector-append)
     (commutative-case
      integer? string? (repeater string string-append)
      (commutative-case-no-match '*))))))

(define generic* (commutative-operator 1 identity dispatch*))

(define-syntax test
  (syntax-rules ()
    ((test x) (begin (write 'x) (display " => ") (write x) (newline)))))

(test (generic*))
(test (generic* 5))
(test (generic* 3 5))
(test (generic* "Ab" 3))
(test (generic* 3 "Ab"))
(test (generic* 3 "Ab" 3))

Output:

(generic*) => 1
(generic* 5) => 5
(generic* 3 5) => 15
(generic* "Ab" 3) => "AbAbAb"
(generic* 3 "Ab") => "AbAbAb"
(generic* 3 "Ab" 3) => "AbAbAbAbAbAbAbAbAb"

[jcubic]

I didn't test your code, but what about. (generic+ '(1 2) "ab") it can't be implemented using your dispatch because this expression is not the same if you swap the arguments. With generic* you can do this because it's just a repeater of sequence, so you always have number and sequence and the order doesn't matter. With + is not the same. Also, I would not care that on numbers + works differently than on e.g. strings.

I think that it would be better to just create a recipe for multiple dispatch on types, and as an example, we can show overwriting + and * so they are not part of the recipe. We can also include your commutative version.

[lassik]

I would not care that on numbers + works differently than on e.g. strings.

We can do it both ways, and publish two recipes.

The things that don't care about argument order, are traditionally called "generic functions" in Lisp, and accept more than 2 arguments. Here's the GF chapter in the book Practical Common Lisp.

Some Scheme implementations support generic functions, e.g. Gauche, and Chicken has a fast-generic egg.

The Lisp (and especially Scheme) communities tend to be more careful about semantics, so something like making + non-commutative is likely to be met with more resistance. But since Lisp is Lisp, it lets you do it anyway.