public inbox for kawa@sourceware.org
 help / color / mirror / Atom feed
From: Damien Mattei <damien.mattei@gmail.com>
To: kawa mailing list <kawa@sourceware.org>
Subject: Re: unbound location: *
Date: Wed, 1 Nov 2023 15:02:48 +0100	[thread overview]
Message-ID: <CADEOadfMeWOLETKzY5xfGgrM+ko1qA5-PHg0w52x-BZW537W=w@mail.gmail.com> (raw)
In-Reply-To: <CADEOade_TLmaonYbkf8sAWsY-LAq3EY5qXnR4L8CG7ahHUhiZw@mail.gmail.com>

[-- Attachment #1: Type: text/plain, Size: 21213 bytes --]

i post a version of my problem independent to Scheme+.
in two attached files containing this kawa code code:
(module-name test-define)

(require 'srfi-1)

(export +)


(define (check-arguments pred-list args)
  (if (= (length pred-list) (length args))
      (let ((pred-arg-list (map cons pred-list args)))
    ;;(andmap (lambda (p) ((car p) (cdr p)))
    ;; replace andmap with every in Guile
    (every (lambda (p) ((car p) (cdr p)))
           pred-arg-list))
      #f))


(define (create-overloaded-existing-operator orig-funct funct
pred-list) ;; works for associative operators

  (display "create-overloaded-existing-operator")
  (display " : pred-list = ") (display pred-list) (newline)
  (define old-funct orig-funct)
  (define new-funct (lambda args ;; args is the list of arguments
              ;; (display "new-funct: new-funct = ") (display
new-funct) (newline)
              ;; (display "new-funct : pred-list = ") (display
pred-list) (newline)
              ;; (display "new-funct : args = ") (display args) (newline)
              (define nb-args (length args))
              ;;(display "new-funct : nb-args = ") (display nb-args) (newline)
              (cond ((check-arguments pred-list args) ;;(begin
                                ;;(display "new funct :calling:")
(display funct) (newline)
                                (apply funct args));;)
                ((> nb-args 2) (new-funct (car args)
                              (apply new-funct (cdr args)))) ;;
op(a,b,...) = op(a,op(b,...))
                (else
                 ;;(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)

  ;;(replace-operator! orig-funct new-funct)

  new-funct)

(define-syntax overload-existing-operator

  (syntax-rules ()

    ((_ orig-funct funct (pred-arg1 ...))
       (define orig-funct (create-overloaded-existing-operator
orig-funct funct (list pred-arg1 ...))))))



; first stage overloading
;;(define-overload-existing-operator +) ;; dummy in this implementation



; second stage overloading
(overload-existing-operator + vector-append (vector? vector?))


(display +) (newline)



and a simple main:
(require test-define)

(define rv (+ #(1 2) #(3 4 5)))
(newline) (display "rv=") (display rv) (newline)

i load it this way:

kawa -Dkawa.import.path=".:/Users/mattei/Dropbox/git/Scheme-PLUS-for-Kawa:./kawa"

(load "/Users/mattei/Dropbox/git/Scheme-PLUS-for-Kawa/main-test-define.scm")

#|kawa:1|# (load
"/Users/mattei/Dropbox/git/Scheme-PLUS-for-Kawa/main-test-define.scm")
/Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/test-define.scm:63:29:
unbound location: +
    at gnu.mapping.PlainLocation.get(PlainLocation.java:22)
    at test-define.run(test-define.scm:63)
    at gnu.expr.ModuleBody.run(ModuleBody.java:51)
    at gnu.expr.ModuleBody.run(ModuleBody.java:35)
    at atInteractiveLevel-2.run(main-test-define.scm:1)
    at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:290)
    at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
    at kawa.Shell.run(Shell.java:289)
    at kawa.Shell.runFile(Shell.java:551)
    at kawa.standard.load.apply2(load.java:67)
    at kawa.standard.load.apply1(load.java:27)
    at gnu.mapping.Procedure1or2.applyToObject(Procedure1or2.java:64)
    at gnu.mapping.Procedure.applyToConsumerDefault(Procedure.java:75)
    at gnu.mapping.CallContext.runUntilDone(CallContext.java:586)
    at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:343)
    at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
    at kawa.Shell.run(Shell.java:289)
    at kawa.Shell.run(Shell.java:196)
    at kawa.Shell.run(Shell.java:183)
    at kawa.repl.processArgs(repl.java:724)
    at kawa.repl.main(repl.java:830)

On Wed, Nov 1, 2023 at 1:50 PM Damien Mattei <damien.mattei@gmail.com> wrote:
>
> a simpler example that lead to the same error:
>
> (module-name test-define)
>
> (require Scheme+)
>
> (export +)
>
> ; first stage overloading
> (define-overload-existing-operator +)
>
>
>
> ; second stage overloading
> (overload-existing-operator + vector-append (vector? vector?))
>
>
> (display +) (newline)
>
>
> a main file:
>
> (require test-define)
>
> (define rv (+ #(1 2) #(3 4 5)))
> (newline) (display "rv=") (display rv) (newline)
>
> result:
> #|kawa:1|# (load
> "/Users/mattei/Dropbox/git/Scheme-PLUS-for-Kawa/main-test-define.scm")
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/array.scm:89:6:
> warning - void-valued expression where value is needed
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:15:10:
> warning - no use of only-one?
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:18:10:
> warning - no use of pair-list?
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:21:10:
> warning - no use of empty?
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:54:10:
> warning - no use of insertNoDups
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:61:10:
> warning - no use of remove-duplicates
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:67:10:
> warning - no use of singleton-list?
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:73:10:
> warning - no use of create-list
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:88:10:
> warning - no use of uniq
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:97:10:
> warning - no use of remove-firsts-elements
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:115:10:
> warning - no use of remove-last
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:157:10:
> warning - no use of debut
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:162:10:
> warning - no use of debut-iter
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:173:10:
> warning - no use of not-list?
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:181:10:
> warning - no use of before-element
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:189:10:
> warning - no use of start-with-element
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/list.scm:198:10:
> warning - no use of pair-list-elements
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/overload.scm:399:10:
> warning - no use of
> find-getter-and-setter-for-overloaded-square-brackets
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/apply-square-brackets.scm:332:7:
> warning - void-valued expression where value is needed
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/apply-square-brackets.scm:337:7:
> warning - void-valued expression where value is needed
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/array.scm:
> note - skipped 0 errors, 29 warnings, 0 notes
> /Users/mattei/Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Kawa/test-define.scm:13:29:
> unbound location: +
>     at gnu.mapping.PlainLocation.get(PlainLocation.java:22)
>     at test-define.run(test-define.scm:13)
>     at gnu.expr.ModuleBody.run(ModuleBody.java:51)
>     at gnu.expr.ModuleBody.run(ModuleBody.java:35)
>     at atInteractiveLevel-2.run(main-test-define.scm:1)
>     at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:290)
>     at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
>     at kawa.Shell.run(Shell.java:289)
>     at kawa.Shell.runFile(Shell.java:551)
>     at kawa.standard.load.apply2(load.java:67)
>     at kawa.standard.load.apply1(load.java:27)
>     at gnu.mapping.Procedure1or2.applyToObject(Procedure1or2.java:64)
>     at gnu.mapping.Procedure.applyToConsumerDefault(Procedure.java:75)
>     at gnu.mapping.CallContext.runUntilDone(CallContext.java:586)
>     at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:343)
>     at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
>     at kawa.Shell.run(Shell.java:289)
>     at kawa.Shell.run(Shell.java:196)
>     at kawa.Shell.run(Shell.java:183)
>     at kawa.repl.processArgs(repl.java:724)
>     at kawa.repl.main(repl.java:830)
>
> why + is unbound? in the worse case i should still have the default addition,no?
>
> seems something is crashing in this code without any element to debug:
> (define (create-overloaded-existing-operator orig-funct funct
> pred-list) ;; works for associative operators
>
>   (display "create-overloaded-existing-operator")
>   (display " : pred-list = ") (display pred-list) (newline)
>   (define old-funct orig-funct)
>   (define new-funct (lambda args ;; args is the list of arguments
>               ;; (display "new-funct: new-funct = ") (display
> new-funct) (newline)
>               ;; (display "new-funct : pred-list = ") (display
> pred-list) (newline)
>               ;; (display "new-funct : args = ") (display args) (newline)
>               (define nb-args (length args))
>               ;;(display "new-funct : nb-args = ") (display nb-args) (newline)
>               (cond ((check-arguments pred-list args) ;;(begin
>                                 ;;(display "new funct :calling:")
> (display funct) (newline)
>                                 (apply funct args));;)
>                 ((> nb-args 2) (new-funct (car args)
>                               (apply new-funct (cdr args)))) ;;
> op(a,b,...) = op(a,op(b,...))
>                 (else
>                  ;;(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)
>
>   (replace-operator! orig-funct new-funct)
>
>   new-funct)
>
> On Wed, Nov 1, 2023 at 1:22 PM Damien Mattei <damien.mattei@gmail.com> wrote:
> >
> > here is a counter example:
> >
> > ;; test-define.scm
> >
> > (module-name test-define)
> >
> > (export *)
> >
> > (display *) (newline)
> >
> > (define * +)
> >
> > (display *) (newline)
> >
> > ;; main-test-define.scm
> >
> > (require test-define)
> >
> > (define rv (* 2 3))
> > (display rv) (newline)
> >
> > #|kawa:1|# (load
> > "/Users/mattei/Dropbox/git/Scheme-PLUS-for-Kawa/main-test-define.scm")
> > #<procedure +>
> > #<procedure +>
> > 5
> >
> > but i do not quite understand , first display shoud have display #<procedure *>
> > but no it displays #<procedure +>
> >
> >
> > On Wed, Nov 1, 2023 at 9:39 AM Damien Mattei <damien.mattei@gmail.com> wrote:
> > >
> > > hello,
> > >
> > > i created a module this way:
> > >
> > > (module-name "matrix")
> > >
> > > (export multiply-matrix-matrix
> > >     multiply-matrix-vector
> > >     matrix
> > >     matrix-v
> > >     create-matrix-by-function
> > >     dim-matrix
> > >     matrix-ref
> > >     matrix-set!
> > >     matrix-line-ref
> > >     matrix-line-set!
> > >     vector->matrix-column
> > >     matrix-column->vector
> > >     *)
> > >
> > > (require Scheme+)
> > >
> > >
> > > ;; (matrix #(1 2 3))
> > > ;; matrix@4612b856
> > >
> > >
> > > (define-simple-class matrix ()
> > >
> > >   (v :: vector)
> > >
> > >   ((*init* (vParam :: vector))
> > >    (set! v vParam))
> > >
> > >   )
> > >
> > > (display "multiply : * =") (display *) (newline)
> > >
> > >
> > > ;; (define M (create-matrix-by-function (lambda (i j) (+ i j)) 2 3))
> > > (define (create-matrix-by-function fct lin col)
> > >   (matrix (create-vector-2d fct lin col)))
> > >
> > >
> > > ;; return the line and column values of dimension
> > > ;; (dim-matrix M)
> > > ;; 2 3
> > > (define (dim-matrix M)
> > >
> > >   (when (not (matrix? M))
> > >     (error "argument is not of type matrix"))
> > >
> > >   {v <+ (matrix-v M)}
> > >   {lin <+ (vector-length v)}
> > >   {col <+ (vector-length {v[0]})}
> > >   (values lin col))
> > >
> > > ;; #|kawa:85|# (define M1 (create-matrix-by-function (lambda (i j) (+
> > > i j)) 2 3))
> > > ;; #|kawa:86|# (define M2 (create-matrix-by-function (lambda (i j) (+
> > > i j)) 3 2))
> > > ;; #|kawa:87|# (multiply-matrix-matrix M1 M2)
> > > ;; matrix@3fc1abf
> > > ;; #|kawa:88|# (define M1*M2 (multiply-matrix-matrix M1 M2))
> > > ;; #|kawa:89|# M1*M2
> > > ;; matrix@3bf5911d
> > > ;; #|kawa:90|# (matrix-v M1*M2)
> > > ;; #(#(5 8) #(8 14))
> > > ;; #|kawa:91|# (matrix-v M1)
> > > ;; #(#(0 1 2) #(1 2 3))
> > > ;; #|kawa:92|# (matrix-v M2)
> > > ;; #(#(0 1) #(1 2) #(2 3))
> > > (define (multiply-matrix-matrix M1 M2)
> > >
> > >   {(n1 p1) <+ (dim-matrix M1)}
> > >   {(n2 p2) <+ (dim-matrix M2)}
> > >
> > >   (when {p1 ≠ n2} (error "matrix.* : matrix product impossible,
> > > incompatible dimensions"))
> > >
> > >   {v1 <+ (matrix-v M1)}
> > >   {v2 <+ (matrix-v M2)}
> > >
> > >   (define (res i j)
> > >     {sum <+ 0}
> > >     (for ({k <+ 0} {k < p1} {k <- k + 1})
> > >      {sum <- sum + v1[i][k] * v2[k][j]})
> > >     (display "sum=")(display sum) (newline)
> > >     sum)
> > >
> > >   {v <+ (create-vector-2d res n1 p2)}
> > >
> > >   (matrix v))
> > >
> > >
> > >
> > > (overload-existing-operator * multiply-matrix-matrix (matrix? matrix?))
> > >
> > >
> > >
> > > ....
> > >
> > > i cut off the whole code, the code used to works with 'include' , now
> > > that i try with modules i stuck on this error at the line
> > > (overload-existing-operator * multiply-matrix-matrix (matrix? matrix?))
> > >
> > > note that matrix+.scm is converted externally in matrix.scm :
> > >
> > > (module-name "matrix")
> > > (export multiply-matrix-matrix multiply-matrix-vector matrix matrix-v
> > >  create-matrix-by-function dim-matrix matrix-ref matrix-set! matrix-line-ref
> > >  matrix-line-set! vector->matrix-column matrix-column->vector *)
> > > (require Scheme+)
> > > (define-simple-class matrix () (v :: vector)
> > >  ((*init* (vParam :: vector)) (set! v vParam)))
> > > (display "multiply : * =")
> > > (display *)
> > > (newline)
> > > (define (create-matrix-by-function fct lin col)
> > >  (matrix (create-vector-2d fct lin col)))
> > > (define (dim-matrix M)
> > >  (when (not (matrix? M)) (error "argument is not of type matrix"))
> > >  (<+ v (matrix-v M)) (<+ lin (vector-length v))
> > >  (<+ col (vector-length (bracket-apply v 0))) (values lin col))
> > > (define (multiply-matrix-matrix M1 M2) (<+ (n1 p1) (dim-matrix M1))
> > >  (<+ (n2 p2) (dim-matrix M2))
> > >  (when (|≠| p1 n2)
> > >   (error "matrix.* : matrix product impossible, incompatible dimensions"))
> > >  (<+ v1 (matrix-v M1)) (<+ v2 (matrix-v M2))
> > >  (define (res i j) (<+ sum 0)
> > >   (for ((<+ k 0) (< k p1) ($nfx$ k <- k + 1))
> > >    ($nfx$ sum <- sum + (bracket-apply (bracket-apply v1 i) k) *
> > >     (bracket-apply (bracket-apply v2 k) j)))
> > >   (display "sum=") (display sum) (newline) sum)
> > >  (<+ v (create-vector-2d res n1 p2)) (matrix v))
> > > (overload-existing-operator * multiply-matrix-matrix (matrix? matrix?))
> > > (define (matrix-v M) (slot-ref M (quote v)))
> > > (define (vector->matrix-column v)
> > >  (matrix (vector-map (lambda (x) (make-vector 1 x)) v)))
> > > (define (matrix-column->vector Mc) (<+ v (matrix-v Mc))
> > >  (vector-map (lambda (v2) (bracket-apply v2 0)) v))
> > > (define (multiply-matrix-vector M v) (<+ Mc (vector->matrix-column v))
> > >  (matrix-column->vector (multiply-matrix-matrix M Mc)))
> > > (define (matrix-ref M lin col) (<+ v (matrix-v M))
> > >  (bracket-apply (bracket-apply v lin) col))
> > > (define (matrix-set! M lin col x) (<+ v (matrix-v M))
> > >  (<- (bracket-apply (bracket-apply v lin) col) x))
> > > (define (matrix-line-ref M lin) (<+ v (matrix-v M)) (bracket-apply v lin))
> > > (define (matrix-line-set! M lin vect-line) (<+ v (matrix-v M))
> > >  (<- (bracket-apply v lin) vect-line))
> > > (overload-square-brackets matrix-ref matrix-set! (matrix? number? number?))
> > > (overload-square-brackets matrix-line-ref matrix-line-set! (matrix? number?))
> > >
> > >
> > > overload-existing-operator redefine the * operator , so basically it
> > > needs the original one to not loose the * between numbers
> > > the code is:
> > >
> > > (define-syntax overload-existing-operator
> > >
> > >   (syntax-rules ()
> > >
> > >     ((_ orig-funct funct (pred-arg1 ...))
> > >        (define orig-funct (create-overloaded-existing-operator
> > > orig-funct funct (list pred-arg1 ...))))))
> > >
> > > (define (create-overloaded-existing-operator orig-funct funct
> > > pred-list) ;; works for associative operators
> > >
> > >   (display "create-overloaded-existing-operator")
> > >   (display " : pred-list = ") (display pred-list) (newline)
> > >   (define old-funct orig-funct)
> > >   (define new-funct (lambda args ;; args is the list of arguments
> > >               ;; (display "new-funct: new-funct = ") (display
> > > new-funct) (newline)
> > >               ;; (display "new-funct : pred-list = ") (display
> > > pred-list) (newline)
> > >               ;; (display "new-funct : args = ") (display args) (newline)
> > >               (define nb-args (length args))
> > >               ;;(display "new-funct : nb-args = ") (display nb-args) (newline)
> > >               (cond ((check-arguments pred-list args) ;;(begin
> > >                                 ;;(display "new funct :calling:")
> > > (display funct) (newline)
> > >                                 (apply funct args));;)
> > >                 ((> nb-args 2) (new-funct (car args)
> > >                               (apply new-funct (cdr args)))) ;;
> > > op(a,b,...) = op(a,op(b,...))
> > >                 (else
> > >                  ;;(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)
> > >
> > >   (replace-operator! orig-funct new-funct)
> > >
> > >   new-funct)
> > >
> > > this weird code  return the new-funct which is the overloaded * , at
> > > the line  (overload-existing-operator * multiply-matrix-matrix
> > > (matrix? matrix?))
> > >
> > > i got this error:
> > > Exception in thread "main" java.lang.ExceptionInInitializerError
> > >     at atInteractiveLevel-8.run(exo_retropropagationNhidden_layers_matrix_v2_by_vectors4kawa+.scm:43)
> > >     at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:290)
> > >     at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
> > >     at kawa.Shell.run(Shell.java:289)
> > >     at kawa.Shell.runFile(Shell.java:551)
> > >     at kawa.standard.load.apply2(load.java:67)
> > >     at kawa.standard.load.apply1(load.java:27)
> > >     at gnu.mapping.Procedure1or2.applyToObject(Procedure1or2.java:64)
> > >     at gnu.mapping.Procedure.applyToConsumerDefault(Procedure.java:75)
> > >     at gnu.mapping.CallContext.runUntilDone(CallContext.java:586)
> > >     at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:343)
> > >     at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
> > >     at kawa.Shell.run(Shell.java:289)
> > >     at kawa.Shell.run(Shell.java:196)
> > >     at kawa.Shell.run(Shell.java:183)
> > >     at kawa.repl.processArgs(repl.java:724)
> > >     at kawa.repl.main(repl.java:830)
> > > Caused by: /Users/mattei/Library/CloudStorage/Dropbox/git/AI_Deep_Learning/kawa/matrix.scm:9:10:
> > > unbound location: *
> > >     at gnu.mapping.PlainLocation.get(PlainLocation.java:22)
> > >     at matrix.<clinit>(matrix.scm:9)
> > >     ... 17 more
> > >
> > > ok * seems not bound to any procedure
> > >
> > > when i display it for debug i got:
> > >
> > > multiply : * =%
> > >
> > > note that % is in reversed colors (white on black background) i cannot
> > > copy/paste it....
> > >
> > > all the code is called from a main file:
> > >
> > > (require matrix)
> > > (require array)
> > >
> > > (require Scheme+)
> > >
> > > it seems in a module * is not bound to anything, i had a same problem
> > > in Racket where i need to import racket/base, is there such a need in
> > > Kawa? ,i can find anything related in the doc.
> > >
> > > regards,
> > > damien

[-- Attachment #2: test-define.scm --]
[-- Type: application/octet-stream, Size: 2148 bytes --]

(module-name test-define)

(require 'srfi-1)

(export +)


(define (check-arguments pred-list args)
  (if (= (length pred-list) (length args))
      (let ((pred-arg-list (map cons pred-list args)))
	;;(andmap (lambda (p) ((car p) (cdr p)))
	;; replace andmap with every in Guile
	(every (lambda (p) ((car p) (cdr p)))
	       pred-arg-list))
      #f))


(define (create-overloaded-existing-operator orig-funct funct pred-list) ;; works for associative operators

  (display "create-overloaded-existing-operator")
  (display " : pred-list = ") (display pred-list) (newline)
  (define old-funct orig-funct)
  (define new-funct (lambda args ;; args is the list of arguments
		      ;; (display "new-funct: new-funct = ") (display new-funct) (newline)
		      ;; (display "new-funct : pred-list = ") (display pred-list) (newline)
		      ;; (display "new-funct : args = ") (display args) (newline)
		      (define nb-args (length args))
		      ;;(display "new-funct : nb-args = ") (display nb-args) (newline)
		      (cond ((check-arguments pred-list args) ;;(begin
								;;(display "new funct :calling:") (display funct) (newline)
								(apply funct args));;)
			    ((> nb-args 2) (new-funct (car args)
						      (apply new-funct (cdr args)))) ;; op(a,b,...) = op(a,op(b,...))
			    (else
			     ;;(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)

  ;;(replace-operator! orig-funct new-funct)

  new-funct)

(define-syntax overload-existing-operator
  
  (syntax-rules ()

    ((_ orig-funct funct (pred-arg1 ...))
       (define orig-funct (create-overloaded-existing-operator orig-funct funct (list pred-arg1 ...))))))



; first stage overloading
;;(define-overload-existing-operator +) ;; dummy in this implementation



; second stage overloading
(overload-existing-operator + vector-append (vector? vector?))


(display +) (newline)


[-- Attachment #3: main-test-define.scm --]
[-- Type: application/octet-stream, Size: 105 bytes --]

(require test-define)

(define rv (+ #(1 2) #(3 4 5)))
(newline) (display "rv=") (display rv) (newline)


  reply	other threads:[~2023-11-01 14:03 UTC|newest]

Thread overview: 12+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-11-01  8:39 Damien Mattei
2023-11-01 12:22 ` Damien Mattei
2023-11-01 12:50   ` Damien Mattei
2023-11-01 14:02     ` Damien Mattei [this message]
2023-11-01 16:11       ` Damien Mattei
2023-11-01 16:47         ` Damien Mattei
2023-11-01 16:57           ` Per Bothner
2023-11-02 21:51             ` Damien Mattei
2023-11-02 21:58               ` Per Bothner
2023-11-03 10:42                 ` Damien Mattei
2023-11-03 10:48                   ` Damien Mattei
2023-11-01 14:55   ` Per Bothner

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='CADEOadfMeWOLETKzY5xfGgrM+ko1qA5-PHg0w52x-BZW537W=w@mail.gmail.com' \
    --to=damien.mattei@gmail.com \
    --cc=kawa@sourceware.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).