From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Damien Mattei Newsgroups: gmane.lisp.guile.user Subject: Re: overload a procedure Date: Sun, 19 Feb 2023 23:07:48 +0100 Message-ID: References: Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="23648"; mail-complaints-to="usenet@ciao.gmane.io" Cc: guile-user To: Vivien Kraus Original-X-From: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Sun Feb 19 23:08:32 2023 Return-path: Envelope-to: guile-user@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pTrrE-00061t-I7 for guile-user@m.gmane-mx.org; Sun, 19 Feb 2023 23:08:32 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pTrqp-0001Am-Np; Sun, 19 Feb 2023 17:08:07 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pTrqn-00019y-II for guile-user@gnu.org; Sun, 19 Feb 2023 17:08:05 -0500 Original-Received: from mail-ed1-x535.google.com ([2a00:1450:4864:20::535]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pTrqk-0008L3-ON for guile-user@gnu.org; Sun, 19 Feb 2023 17:08:05 -0500 Original-Received: by mail-ed1-x535.google.com with SMTP id ec23so4826393edb.1 for ; Sun, 19 Feb 2023 14:08:02 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:from:to:cc:subject:date:message-id:reply-to; bh=SYh5i0SW7C7EKCWqeObv1rOSdCvmPPPLjGx38ADTQwQ=; b=iirtDd7aoXocqAv2SKQTqwU6oeO9At48CJ/ysSC4MKTjW5y3157n61xOm/q1P6FuRw VVW5eag0IAKD5NeNQZtSU2yW5n6I1zqmnVjeNi1lAJf91Ti38h2hl+kXjVGpB3GSyBZZ dbBx++jo3l3N4YoUohIIWH/178Cc7PCVTTZ9jeJ7qP0/iEQNvPv28p0FlktrgwhHVuNq e8W3GI7oWnhg+K9rjgkKfKbO0KUfHBLXLHLlM9lPOEp+tZ/Z0gdtrKTKwsNP08cGVM6A 1xg9iU6SPkRkllECxdkmIcDsGUf+1QPSUK475266HZpy0lSIRFsm0LtQk7UtS3mQWB0S 5Mpg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=SYh5i0SW7C7EKCWqeObv1rOSdCvmPPPLjGx38ADTQwQ=; b=MNGlLZXAuqu3elQW/eVQvS3ocK4gRe+TNCIfzLXPDiKysytxrHSrILYd73GGCD49f0 Rfi/q83j9IT55RyUdM+yZenaYmTLbKY/+EK3zGIu2oUGIdyC9L9XISLGcJb/qG6eZMbT rlAA5lE0Yy4vniCpz2+QkIwuGcWCjgdR2AdjEEm9rOVUKZYCPunm739aTf9x+3o00PCi bvGrQlHxXfKH2+9NjaecPa3dgCQtqzARqhNo4exsX4zAMcIa9OzVE2vzd4pLiYJ4sUHM y4By2nyF6MW7/j9ZhfdGikoc8TQ1uyvkWK5bAc2Qphj3GD+vs+4TzCFnXNHT8sWXxqPr 367w== X-Gm-Message-State: AO0yUKW54Vltocdy87thq9VQWAR77eNpOZHCz4m+pdoNV5S5UPZPWdgq qb+Vktpzoubu32S6L0yTSC6pJbEYxNnazkhzKH/ECjux3ts= X-Google-Smtp-Source: AK7set/dnuDJ01Dqv6fsfU6Xm55LEMBQJrWlx+XPuAx/kJnQAZFZsRAWzCMxaP7A0N/D0i36UkIyqIeYUwDpARH1pf8= X-Received: by 2002:a17:906:79b:b0:87b:db55:4887 with SMTP id l27-20020a170906079b00b0087bdb554887mr3109726ejc.4.1676844479741; Sun, 19 Feb 2023 14:07:59 -0800 (PST) In-Reply-To: Received-SPF: pass client-ip=2a00:1450:4864:20::535; envelope-from=damien.mattei@gmail.com; helo=mail-ed1-x535.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, HTML_MESSAGE=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Content-Filtered-By: Mailman/MimeDel 2.1.29 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.user:18920 Archived-At: 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 ) (b )) (vector-append a b)) scheme@(guile-user)> (+ #(1 2 3) #(4 5)) $3 =3D #(1 2 3 4 5) scheme@(guile-user)> (+ #(1 2 3) #(4 5) #(2 5)) $4 =3D #(1 2 3 4 5 2 5) scheme@(guile-user)> (define (add-list-list L1 L2) (map + L1 L2)) scheme@(guile-user)> $5 =3D #< 102b5a780> scheme@(guile-user)> $6 =3D #< 102b5aa00> scheme@(guile-user)> (define-method (+ (a ) (b )) (add-list-list a b)) scheme@(guile-user)> (+ '(1 2 3) '(4 5 6)) $7 =3D (5 7 9) scheme@(guile-user)> (+ '(1 2 3) '(4 5 6) '(7 8 9)) $8 =3D (12 15 18) scheme@(guile-user)> (define-method (area (a )) (* a a)) scheme@(guile-user)> (area 3) $9 =3D 9 scheme@(guile-user)> (define-method (area (a ) (b )) (* a b)) scheme@(guile-user)> (area 3 4) $10 =3D 12 scheme@(guile-user)> {'(1 2 3) + '(4 5 6)} $11 =3D (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 =3D ") (display pred-list) (newline) (define pred-arg-list (map cons pred-list args)) (display "new-funct : pred-arg-list =3D ") (display pred-arg-list) (newline) (define chk-args (andmap (=CE=BB (p) ((car p) (cdr p))) pred-arg-list)) (display "new-funct : chk-args =3D ") (display chk-args) (newline) (display "new-funct : args =3D ") (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: # orig-funct: # old-funct: # new-funct: # scheme@(guile-user)> (+ 2 3) new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 2) (# . 3)) new-funct : chk-args =3D #f new-funct : args =3D (2 3) new funct :calling:# $1 =3D 5 scheme@(guile-user)> (+ '(1 2 3) '(4 5 6)) new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# 1 2 3) (# 4 5 6)) new-funct : chk-args =3D #t new-funct : args =3D ((1 2 3) (4 5 6)) new funct :calling:# $2 =3D (5 7 9) scheme@(guile-user)> (+ '(1 2 3) '(4 5 6) '(7 8 9)) new-funct: # new-funct : pred-list =3D (# #) 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: # orig-funct: # old-funct: # new-funct: # scheme@(guile-user)> (+ (cons 1 2) (cons 3 4)) new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# 1 . 2) (# 3 . 4)) new-funct : chk-args =3D #t new-funct : args =3D ((1 . 2) (3 . 4)) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 1) (# . 3)) new-funct : chk-args =3D #f new-funct : args =3D (1 3) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 1) (# . 3)) new-funct : chk-args =3D #f new-funct : args =3D (1 3) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 2) (# . 4)) new-funct : chk-args =3D #f new-funct : args =3D (2 4) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 2) (# . 4)) new-funct : chk-args =3D #f new-funct : args =3D (2 4) new funct :calling:# $3 =3D (4 . 6) scheme@(guile-user)> (+ 3 4) new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 3) (# . 4)) new-funct : chk-args =3D #f new-funct : args =3D (3 4) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 3) (# . 4)) new-funct : chk-args =3D #f new-funct : args =3D (3 4) new funct :calling:# $4 =3D 7 scheme@(guile-user)> (+ '(1 2 3) '(4 5 6)) new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# 1 2 3) (# 4 5 6)) new-funct : chk-args =3D #t new-funct : args =3D ((1 2 3) (4 5 6)) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 1) (# . 4)) new-funct : chk-args =3D #f new-funct : args =3D (1 4) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 1) (# . 4)) new-funct : chk-args =3D #f new-funct : args =3D (1 4) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# 2 3) (# 5 6)) new-funct : chk-args =3D #t new-funct : args =3D ((2 3) (5 6)) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 2) (# . 5)) new-funct : chk-args =3D #f new-funct : args =3D (2 5) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 2) (# . 5)) new-funct : chk-args =3D #f new-funct : args =3D (2 5) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# 3) (# 6)) new-funct : chk-args =3D #t new-funct : args =3D ((3) (6)) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 3) (# . 6)) new-funct : chk-args =3D #f new-funct : args =3D (3 6) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((# . 3) (# . 6)) new-funct : chk-args =3D #f new-funct : args =3D (3 6) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((#) (#)) new-funct : chk-args =3D #f new-funct : args =3D (() ()) new funct :calling:# new-funct: # new-funct : pred-list =3D (# #) new-funct : pred-arg-list =3D ((#) (#)) new-funct : chk-args =3D #t new-funct : args =3D (() ()) new funct :calling:# $5 =3D (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 wrote: > Hi Damien, > > Le dimanche 19 f=C3=A9vrier 2023 =C3=A0 18:45 +0100, Damien Mattei a =C3= =A9crit : > > 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 ) (b )) (vector-append a b)) > (+ #(1 2 3) #(4 5)) > > Vivien >