overload a procedure

overload a procedure

[Damien Mattei]

hello,

i try to make a macro to overload a procedure in scheme.

i already done it in Python in two ways:
-with decorator using a hash table that save the functions and the
parameters types:
https://github.com/damien-mattei/vision3D_python/blob/master/Overload_by_class.py
-with decorator and functions using recursive functions that check the
parameters at each level of recursion until it fall back to the good
parameters types or default to the built in procedure:
https://github.com/damien-mattei/vision3D_python/blob/master/Overload_by_function_recursive.py
i suppose it works, at least the Overload_by_class.py has been already used
intensively in :
https://github.com/damien-mattei/vision3D_python/blob/master/Matrix3x3.py

ok now i come to the scheme problem implementing the two solutions; in
scheme i can not use types so i use type predicates (number? verctor?
string? list?....)to identify the good function depending of the parameters
types find with the predicates.
i tried with macro and recursive function with this solution:

example of use::
(overload + add-vect-vect vector? vector?)

here is the code:

;; overload

;; (define-module (overload-recursive)
;;   #:use-module ((guile))
;;   #:export (overload))

;; alternate: comment above and (load "overload-recursive.scm")

;; (use-modules (overload-recursive))
;; (define (mult-num-vect k v) (map (λ (x) (* k x)) v))

;; (overload * mult-num-vect number? list?)

;;(* 3 '(1 2 3))

;; scheme@(guile-user)> (use-modules (overload-recursive))
;; scheme@(guile-user)> (define (add-list-list L1 L2) (map + L1 L2))
;; scheme@(guile-user)> (overload + add-list-list list? list?)
;; scheme@(guile-user)> (+ '(1 2 3) '(4 5 6))

;; (use-modules (srfi srfi-43)) ;; vector-map
;; (define (add-vect-vect V1 V2) (vector-map + V1 V2))
;; (overload + add-vect-vect vector? vector?)
;; (+ (vector 1 2 3) (vector 4 5 6))

;; exist in Racket but not Guile
(define andmap
  (lambda (function list1 . more-lists)
    (letrec ((some? (lambda (fct list)
     ;; returns #f if (function x) returns #t for
     ;; some x in the list
     (and (pair? list)
  (or (fct (car list))
      (some? fct (cdr list)))))))

      ;; variadic map implementation terminates
      ;; when any of the argument lists is empty.
      (let ((lists (cons list1 more-lists)))
(if (some? null? lists)
   #t
   (and (apply function (map car lists))
(apply andmap function (map cdr lists))))))))

;; scheme@(guile-user)> {3 * '(1 2 3)}
;; $3 = (3 6 9)

;; scheme@(guile-user)> (define (add-vect-vect v1 v2) (map + v1 v2))
;; scheme@(guile-user)> (add-vect-vect '(1 2 3) '(4 5 6))
;; $4 = (5 7 9)
;; scheme@(guile-user)> (overload + add-vect-vect list? list?)
;; scheme@(guile-user)> (+ '(1 2 3) '(4 5 6))
;; $5 = (5 7 9)
;; scheme@(guile-user)> (+ '(1 2 3) '(4 5 6) '(7 8 9))
;; $6 = (12 15 18)

;; scheme@(guile-user)> (+ '(1 2 3))
;; $7 = (1 2 3)

;; scheme@(guile-user)> (define (add-pair p1 p2) (cons (+ (car p1) (car
p2)) (+ (cdr p1) (cdr p2))))
;; scheme@(guile-user)> (overload + add-pair pair? pair?)
;; overload
;; scheme@(guile-user)> (+ (cons 1 2) (cons 3 4))
(define-syntax overload

  (syntax-rules ()


    ((_ orig-funct funct pred-arg1 ...)  (begin
 (display "overload") (newline)
 (define old-funct orig-funct)
     (define new-funct (lambda args ;; args is the list of arguments
     (display "new-funct: ") (display new-funct) (newline)
         (define pred-list (list pred-arg1 ...))
         (display "new-funct : pred-list = ") (display pred-list) (newline)
         (define pred-arg-list (map cons pred-list args))
         (display "new-funct : pred-arg-list = ") (display pred-arg-list)
(newline)

     (define chk-args (andmap (λ (p) ((car p) (cdr p)))
            pred-arg-list))
         (display "new-funct : chk-args = ") (display chk-args) (newline)
     (display "new-funct : args = ") (display args) (newline)
         (if chk-args
 (begin
   (display "new funct :calling:") (display funct) (newline)
   (apply funct args))
 (begin
   (display "new funct :calling:") (display old-funct) (newline)
   (apply old-funct args)))))
 (display "funct: ") (display funct) (newline)
 (display "orig-funct: ") (display orig-funct) (newline)
 (display "old-funct: ") (display old-funct) (newline)
 (display "new-funct: ") (display new-funct) (newline)

     ;;(set! orig-funct new-funct)
 (define orig-funct new-funct)
 ;;(display "after set!: orig-funct: ")
 (display "after re-define: orig-funct: ") (display orig-funct)
(newline)))))




     ;; ((_ orig-funct funct pred-arg1 ...)  (let* ((old-funct orig-funct)
     ;; (new-funct  (lambda args ;; args is the list of arguments
     ;;      (display "new-funct: ") (display new-funct) (newline)
     ;;      (define pred-list (list pred-arg1 ...))
     ;;      (display "new-funct : pred-list = ") (display pred-list)
(newline)
     ;;      (define pred-arg-list (map cons pred-list args))
     ;;      (display "new-funct : pred-arg-list = ") (display
pred-arg-list) (newline)

     ;;      (define chk-args (andmap (λ (p) ((car p) (cdr p)))
     ;;             pred-arg-list))
     ;;      (display "new-funct : chk-args = ") (display chk-args)
(newline)
     ;;      (display "new-funct : args = ") (display args) (newline)
     ;;      (if chk-args
     ;;  (begin
     ;;    (display "new funct :calling:") (display funct) (newline)
     ;;    (apply funct args))
     ;;  (begin
     ;;    (display "new funct :calling:") (display old-funct) (newline)
     ;;    (apply old-funct args))))))

     ;;   (display "funct: ") (display funct) (newline)
     ;;   (display "orig-funct: ") (display orig-funct) (newline)
     ;;   (display "old-funct: ") (display old-funct) (newline)
     ;;   (display "new-funct: ") (display new-funct) (newline)

     ;;   ;;(set! orig-funct new-funct)
     ;;   (define orig-funct new-funct)
     ;;   ;;(display "after set!: orig-funct: ")
     ;;   (display "after re-define: orig-funct: ") (display orig-funct)
(newline)
     ;;   ))))

unfortunately it fail to overload correctly:

scheme@(guile-user)> (use-modules (overload-recursive))
;;; note: source file /usr/local/share/guile/site/3.0/overload-recursive.scm
;;;       newer than compiled
/Users/mattei/.cache/guile/ccache/3.0-LE-8-4.6/usr/local/share/guile/site/3.0/overload-recursive.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling /usr/local/share/guile/site/3.0/overload-recursive.scm
;;; compiled
/Users/mattei/.cache/guile/ccache/3.0-LE-8-4.6/usr/local/share/guile/site/3.0/overload-recursive.scm.go
scheme@(guile-user)> (define (add-list-list L1 L2) (map + L1 L2))
scheme@(guile-user)> (overload + add-list-list list? list?)
;;; <stdin>:3:10: warning: non-idempotent binding for `+'.  When first
loaded, value for `+` comes from imported binding, but later module-local
definition overrides it; any module reload would capture module-local
binding rather than import.
;;; <stdin>:3:10: warning: non-idempotent binding for `+'.  When first
loaded, value for `+` comes from imported binding, but later module-local
definition overrides it; any module reload would capture module-local
binding rather than import.
overload
funct: #<procedure add-list-list (L1 L2)>
orig-funct: #<procedure + (#:optional _ _ . _)>
old-funct: #<procedure + (#:optional _ _ . _)>
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
after re-define: orig-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
scheme@(guile-user)> (+ '(1 2 3) '(4 5 6))
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> 1 2 3) (#<procedure
list? (_)> 4 5 6))
new-funct : chk-args = #t
new-funct : args = ((1 2 3) (4 5 6))
new funct :calling:#<procedure add-list-list (L1 L2)>
$1 = (5 7 9)
scheme@(guile-user)> (use-modules (srfi srfi-43)) ;; vector-map
scheme@(guile-user)>  (define (add-vect-vect V1 V2) (vector-map + V1 V2))

scheme@(guile-user)>  (overload + add-vect-vect vector? vector?)
overload
funct: #<procedure add-vect-vect (V1 V2)>
orig-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
old-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
after re-define: orig-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
scheme@(guile-user)> (+ '(1 2 3) '(4 5 6))
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
new-funct : pred-list = (#<procedure vector? (_)> #<procedure vector? (_)>)
new-funct : pred-arg-list = ((#<procedure vector? (_)> 1 2 3) (#<procedure
vector? (_)> 4 5 6))
new-funct : chk-args = #f
new-funct : args = ((1 2 3) (4 5 6))
new funct :calling:#<procedure new-funct-3b4b7258f9d0b3 args>
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> 1 2 3) (#<procedure
list? (_)> 4 5 6))
new-funct : chk-args = #t
new-funct : args = ((1 2 3) (4 5 6))
new funct :calling:#<procedure add-list-list (L1 L2)>
$2 = (5 7 9)
scheme@(guile-user)> (+ 3 4)
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
new-funct : pred-list = (#<procedure vector? (_)> #<procedure vector? (_)>)
new-funct : pred-arg-list = ((#<procedure vector? (_)> . 3) (#<procedure
vector? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (3 4)
new funct :calling:#<procedure new-funct-3b4b7258f9d0b3 args>
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 3) (#<procedure
list? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (3 4)
new funct :calling:#<procedure new-funct-3b4b7258f9d0b3 args>
new-funct: #<procedure new-funct-3b4b7258f9d0b3 args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 3) (#<procedure
list? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (3 4)

it run in an infinite recursive call.

the problem seems to come from macro and hygiene and the procedure :
#<procedure new-funct-3b4b7258f9d0b3 args>
that always have look the same at any level of overloading.
also this message:
warning: non-idempotent binding for `+'.  When first loaded, value for `+`
comes from imported binding, but later module-local definition overrides
it; any module reload would capture module-local binding rather than import.
can be bind to the problem.

It is an interesting but hard problem to solve and i'm searching some help.
Or if someone has an alternate solution to to an overloading macro that
would works like this:
(define (add-vect-vect V1 V2) (vector-map + V1 V2))
(overload + add-vect-vect vector? vector?)

best regards,
Damien

Re: overload a procedure

[Vivien Kraus]

Hi Damien,

Le dimanche 19 février 2023 à 18:45 +0100, Damien Mattei a écrit :
> ok now i come to the scheme problem implementing the two solutions;
> in
> scheme i can not use types so i use type predicates (number? verctor?
> string? list?....)to identify the good function depending of the
> parameters
> types find with the predicates.
> i tried with macro and recursive function with this solution:
> 
> example of use::
> (overload + add-vect-vect vector? vector?)

Did you try GOOPS? It provides that kind of functionality.

(use-modules (oop goops) (srfi srfi-43))
(define-method (+ (a <vector>) (b <vector>)) (vector-append a b))
(+ #(1 2 3) #(4 5))

Vivien

Re: overload a procedure

[Damien Mattei]

yes your are right, it works with GOOPS out of the box.
scheme@(guile-user)> (use-modules (oop goops) (srfi srfi-43))
scheme@(guile-user)> (define-method (+ (a <vector>) (b <vector>))
(vector-append a b))
scheme@(guile-user)> (+ #(1 2 3) #(4 5))
$3 = #(1 2 3 4 5)
scheme@(guile-user)> (+ #(1 2 3) #(4 5) #(2 5))
$4 = #(1 2 3 4 5 2 5)
scheme@(guile-user)> (define (add-list-list L1 L2) (map + L1 L2))
scheme@(guile-user)> <vector>
$5 = #<<class> <vector> 102b5a780>
scheme@(guile-user)> <list>
$6 = #<<class> <list> 102b5aa00>
scheme@(guile-user)> (define-method (+ (a <list>) (b <list>))
(add-list-list a b))
scheme@(guile-user)> (+ '(1 2 3) '(4 5 6))
$7 = (5 7 9)
scheme@(guile-user)> (+ '(1 2 3) '(4 5 6) '(7 8 9))
$8 = (12 15 18)
scheme@(guile-user)> (define-method (area (a <number>)) (* a a))
scheme@(guile-user)> (area 3)
$9 = 9
scheme@(guile-user)> (define-method (area (a <number>) (b <number>)) (* a
b))
scheme@(guile-user)> (area 3 4)
$10 = 12
scheme@(guile-user)> {'(1 2 3) + '(4 5 6)}
$11 = (5 7 9)

i wanted a more portable solution, i'm coming near a solution that works
with a procedure, not a macro:

(define (overload-proc orig-funct funct pred-list)

  (display "overload-proc") (newline)
  (define old-funct orig-funct)
  (define new-funct (lambda args ;; args is the list of arguments
     (display "new-funct: ") (display new-funct) (newline)
     (display "new-funct : pred-list = ") (display pred-list) (newline)
     (define pred-arg-list (map cons pred-list args))
     (display "new-funct : pred-arg-list = ") (display pred-arg-list)
(newline)

     (define chk-args (andmap (λ (p) ((car p) (cdr p)))
      pred-arg-list))
     (display "new-funct : chk-args = ") (display chk-args) (newline)
     (display "new-funct : args = ") (display args) (newline)

     (if chk-args
 (begin
   (display "new funct :calling:") (display funct) (newline)
   (apply funct args))
 (begin
   (display "new funct :calling:") (display old-funct) (newline)
   (apply old-funct args)))))

  (display "funct: ") (display funct) (newline)
  (display "orig-funct: ") (display orig-funct) (newline)
  (display "old-funct: ") (display old-funct) (newline)
  (display "new-funct: ") (display new-funct) (newline)

  new-funct)

still a few things to fix like dealing with an arbitrary number of
parameters (what GOOPS do very well) and it will be good:

 scheme@(guile-user)> (load "overload-recursive.scm")
scheme@(guile-user)> (define (add-list-list L1 L2) (map + L1 L2))
scheme@(guile-user)> (define + (overload-proc + add-list-list (list list?
list?)))
overload-proc
funct: #<procedure add-list-list (L1 L2)>
orig-funct: #<procedure + (#:optional _ _ . _)>
old-funct: #<procedure + (#:optional _ _ . _)>
new-funct: #<procedure new-funct args>
scheme@(guile-user)> (+ 2 3)
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 2) (#<procedure
list? (_)> . 3))
new-funct : chk-args = #f
new-funct : args = (2 3)
new funct :calling:#<procedure + (#:optional _ _ . _)>
$1 = 5
scheme@(guile-user)> (+ '(1 2 3) '(4 5 6))
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> 1 2 3) (#<procedure
list? (_)> 4 5 6))
new-funct : chk-args = #t
new-funct : args = ((1 2 3) (4 5 6))
new funct :calling:#<procedure add-list-list (L1 L2)>
$2 = (5 7 9)
scheme@(guile-user)> (+ '(1 2 3) '(4 5 6) '(7 8 9))
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure map: List of wrong length: ((1 2 3) (4 5 6) (7 8 9))

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,q
scheme@(guile-user)> (define (add-pair p1 p2) (cons (+ (car p1) (car p2))
(+ (cdr p1) (cdr p2))))
scheme@(guile-user)> (define + (overload-proc + add-pair (list pair?
pair?)))
overload-proc
funct: #<procedure add-pair (p1 p2)>
orig-funct: #<procedure new-funct args>
old-funct: #<procedure new-funct args>
new-funct: #<procedure new-funct args>
scheme@(guile-user)> (+ (cons 1 2) (cons 3 4))
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> 1 . 2) (#<procedure
pair? (_)> 3 . 4))
new-funct : chk-args = #t
new-funct : args = ((1 . 2) (3 . 4))
new funct :calling:#<procedure add-pair (p1 p2)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> . 1) (#<procedure
pair? (_)> . 3))
new-funct : chk-args = #f
new-funct : args = (1 3)
new funct :calling:#<procedure new-funct args>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 1) (#<procedure
list? (_)> . 3))
new-funct : chk-args = #f
new-funct : args = (1 3)
new funct :calling:#<procedure + (#:optional _ _ . _)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> . 2) (#<procedure
pair? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (2 4)
new funct :calling:#<procedure new-funct args>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 2) (#<procedure
list? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (2 4)
new funct :calling:#<procedure + (#:optional _ _ . _)>
$3 = (4 . 6)
scheme@(guile-user)> (+ 3 4)
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> . 3) (#<procedure
pair? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (3 4)
new funct :calling:#<procedure new-funct args>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 3) (#<procedure
list? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (3 4)
new funct :calling:#<procedure + (#:optional _ _ . _)>
$4 = 7
scheme@(guile-user)> (+ '(1 2 3) '(4 5 6))
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> 1 2 3) (#<procedure
pair? (_)> 4 5 6))
new-funct : chk-args = #t
new-funct : args = ((1 2 3) (4 5 6))
new funct :calling:#<procedure add-pair (p1 p2)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> . 1) (#<procedure
pair? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (1 4)
new funct :calling:#<procedure new-funct args>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 1) (#<procedure
list? (_)> . 4))
new-funct : chk-args = #f
new-funct : args = (1 4)
new funct :calling:#<procedure + (#:optional _ _ . _)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> 2 3) (#<procedure
pair? (_)> 5 6))
new-funct : chk-args = #t
new-funct : args = ((2 3) (5 6))
new funct :calling:#<procedure add-pair (p1 p2)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> . 2) (#<procedure
pair? (_)> . 5))
new-funct : chk-args = #f
new-funct : args = (2 5)
new funct :calling:#<procedure new-funct args>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 2) (#<procedure
list? (_)> . 5))
new-funct : chk-args = #f
new-funct : args = (2 5)
new funct :calling:#<procedure + (#:optional _ _ . _)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> 3) (#<procedure pair?
(_)> 6))
new-funct : chk-args = #t
new-funct : args = ((3) (6))
new funct :calling:#<procedure add-pair (p1 p2)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)> . 3) (#<procedure
pair? (_)> . 6))
new-funct : chk-args = #f
new-funct : args = (3 6)
new funct :calling:#<procedure new-funct args>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)> . 3) (#<procedure
list? (_)> . 6))
new-funct : chk-args = #f
new-funct : args = (3 6)
new funct :calling:#<procedure + (#:optional _ _ . _)>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure pair? (_)> #<procedure pair? (_)>)
new-funct : pred-arg-list = ((#<procedure pair? (_)>) (#<procedure pair?
(_)>))
new-funct : chk-args = #f
new-funct : args = (() ())
new funct :calling:#<procedure new-funct args>
new-funct: #<procedure new-funct args>
new-funct : pred-list = (#<procedure list? (_)> #<procedure list? (_)>)
new-funct : pred-arg-list = ((#<procedure list? (_)>) (#<procedure list?
(_)>))
new-funct : chk-args = #t
new-funct : args = (() ())
new funct :calling:#<procedure add-list-list (L1 L2)>
$5 = (5 7 9)
sorry for the verbose output, it is still in developping...
regards,
damien

On Sun, Feb 19, 2023 at 6:52 PM Vivien Kraus <vivien@planete-kraus.eu>
wrote:

> Hi Damien,
>
> Le dimanche 19 février 2023 à 18:45 +0100, Damien Mattei a écrit :
> > ok now i come to the scheme problem implementing the two solutions;
> > in
> > scheme i can not use types so i use type predicates (number? verctor?
> > string? list?....)to identify the good function depending of the
> > parameters
> > types find with the predicates.
> > i tried with macro and recursive function with this solution:
> >
> > example of use::
> > (overload + add-vect-vect vector? vector?)
>
> Did you try GOOPS? It provides that kind of functionality.
>
> (use-modules (oop goops) (srfi srfi-43))
> (define-method (+ (a <vector>) (b <vector>)) (vector-append a b))
> (+ #(1 2 3) #(4 5))
>
> Vivien
>