(define-syntax bar
(syntax-rules ()
((_ proc)
(require (rename-in racket/base (proc
identifier))))))
how can i create identifier to be like base:proc example (bar +)
identifier would be base:+
if possible with rackt/syntax of without it?
See format-id and note that you may need to syntax-local-introduce the require form.
i have a limited reader (perheaps i can improve it) that fail on non standart extension of Scheme language, such exist in Racket:
Welcome to DrRacket, version 8.9 [cs].
Language: reader "../Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/SRFI/SRFI-105.rkt", with debugging; memory limit: 8192 MB.
> (require racket/syntax)
> (define-syntax (better-make-pred stx)
(syntax-case stx ()
[(better-make-pred name)
(format-id #'name #:source #'name
"~a?" (syntax-e #'name))]))
Error: SRFI-105 REPL : Unsupported #' extension
Error: SRFI-105 REPL :Unsupported # extension unsupported character causing this message is character::
Error: SRFI-105 REPL : Unsupported #' extension
Error: SRFI-105 REPL : Unsupported #' extension
#%app: missing procedure expression;
probably originally (), which is an illegal empty application in: (#%app)
i prefer stay compatible with many Scheme implementation.
but i can use something like that :
(define-syntax bar
(syntax-rules ()
((_ proc)
(begin
(require (rename-in racket/base (proc
orig-proc)))
(define (proc a b)
(list
(orig-proc a b)
(* a b)))
)
)))
> (bar +)
> (+ 2 3)
'(5 6)
the example is stupid but ,it prove i can rewrite a procedure and keeping the old one in memory (in the environment definition of the new procedure)
i hope it is ok for what i want to do
thank
Probably you know this, but (require (rename-in racket/base (proc orig-proc))) is not going to be compatible with any other Scheme implementation.
Typically, portable Scheme code has some non-portable utilities specialized for each Scheme implementation. If you are writing the Racket-specific implementation of those utilities, you are free to use additional Racket features.
yes in Guile i can use define-method to overwrite an overloaded procedure,
i'm a bit limited with extra syntax feature of various scheme , but it is a good habit to try to stay compatible ,as i will port the code to Guile and hope Chicken Scheme one day , it spare time during ports.
I would suggest something like this, so you aren't limited to contexts where require can appear:
#lang racket
(define-syntax (bar stx)
(syntax-case stx ()
[(_ proc)
(identifier? #'proc)
#`(define-syntax proc
(make-rename-transformer
(quote-syntax #,(syntax-local-lift-require
`(only racket/base ,(syntax-e #'proc))
(datum->syntax #f (syntax-e #'proc))
#t))))]))
(let ([+ list])
(values (+ 1 2)
(let ()
(bar +)
(+ 1 2))))
You can use syntax or quote-syntax instead of #'.
i'm not understanding the code,
my goal was to have a macro that redefine a procedure with a new procedure that use the original one in its code
yes it is true, so it could work in my REPL
when i test the code i got this error:
Welcome to DrRacket, version 8.6 [cs].
Language: racket, with debugging; memory limit: 14000 MB.
. . ../../usr/share/racket/pkgs/errortrace-lib/errortrace/stacktrace.rkt:690:2: syntax-local-lift-require: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 3
strange it seems to work yesterday but i'm not sure
There was a change to syntax-local-lift-require in Racket 8.7. You can either upgrade your Racket to fix the problem, or alternatively remove the third argument (#t), which would allow it to run in Racket 8.6.
I'm not sure if @LiberalArtist was intentional about adding that third argument anyway, since the third argument was incorrectly documented (fixed in https://github.com/racket/racket/pull/4718).
yes i was using two computer, one have an old version of racket
i'm renaming the identifier, or duplicating it with rename-in but strangely my code is not working, i post it for help, sorry for the length but i have no idea why it fails, it is some overloading procedure not completely written but they should work (at least for new procedures):
(require srfi/69) ;; Basic hash tables
(define $ovrld-ht$ (make-hash-table))
(define-syntax overload
(syntax-rules ()
;; arguments are function to be overloaded, procedure that do the overloading, list of predicate to check the arguments
((_ funct-symb proc (pred-arg1 ...))
(overload-procedure funct-symb proc (pred-arg1 ...)))
;;((_ funct-symb proc (pred-arg1 ...) quote-operator)
;;(begin
;; (overload-operator funct-symb proc (pred-arg1 ...))
;; (update-operators))
;; )
;;((_ funct-symb proc (pred-arg1 ...) quote-operator quote-n-arity)
;;(begin
;;(overload-n-arity-operator funct-symb proc (pred-arg1 ...))
;;(update-operators)))
))
(define-syntax overload-procedure
(syntax-rules ()
((_ orig-funct funct (pred-arg1 ...))
(let ((ovrld-lst (hash-table-ref $ovrld-ht$ orig-funct)))
(hash-table-set! $ovrld-ht$ orig-funct
(cons (list (list pred-arg1 ...) ;; example: ((number? string?) (lambda (n s) (display n) (display s) (newline)))
funct)
ovrld-lst))))))
;; args must be the same number as predicates and their types must match
(define (check-arguments pred-list args)
(if (= (length pred-list) (length args))
(let ((pred-arg-list (map cons pred-list args)))
(andmap (λ (p) ((car p) (cdr p)))
;; replace andmap with every in Guile
;;(every (λ (p) ((car p) (cdr p)))
pred-arg-list))
#f))
(define-syntax define-overload-existing-procedure
(syntax-rules ()
((_ proc)
(begin
(require (rename-in racket/base (proc
orig-proc)))
(define (proc . args-lst)
(display proc) (newline)
(define ht (hash-table->alist $ovrld-ht$))
(display ht) (newline)
(define proc-lst (hash-table-ref $ovrld-ht$ proc)) ;; example: ((number? string?) (lambda (n s) (display n) (display s) (newline)))
;;(display proc-lst)
;;(newline)
(define (check-args-lst pred-list) ; check arguments list match predicates
(check-arguments pred-list args-lst))
(define (test-proc pred-proc-list) ; test the procedure if it matches with arguments
(if (check-args-lst (car pred-proc-list))
(car (cdr pred-proc-list))
#f))
(define proc-search-result (ormap test-proc proc-lst)) ; search for a procedure matching arguments
(if proc-search-result
(apply proc-search-result args-lst)
(apply orig-proc args-lst)))
(hash-table-set! $ovrld-ht$ proc '())))))
;; > (define-overload-procedure area)
;; > (define (area-square x) (* x x))
;; > (area-square 4)
;; 16
;; > (hash-table->alist $ovrld-ht$)
;; '((#<procedure:area>))
;; > (overload area area-square (number?))
;; > (hash-table->alist $ovrld-ht$)
;; '((#<procedure:area> ((#<procedure:number?>) #<procedure:area-square>)))
;; > (area 2)
;; 4
;; > (define (area-rectangle x y) (* x y))
;; > (overload area area-rectangle (number? number?))
;; > (area 2 5)
;; 10
(define-syntax define-overload-procedure
(syntax-rules ()
((_ proc)
(begin
(define (proc . args-lst)
(define proc-lst (hash-table-ref $ovrld-ht$ proc)) ;; example: ((number? string?) (lambda (n s) (display n) (display s) (newline)))
;;(display proc-lst)
;;(newline)
(define (check-args-lst pred-list) ; check arguments list match predicates
(check-arguments pred-list args-lst))
(define (test-proc pred-proc-list) ; test the procedure if it matches with arguments
(if (check-args-lst (car pred-proc-list))
(car (cdr pred-proc-list))
#f))
(define proc-search-result (ormap test-proc proc-lst)) ; search for a procedure matching arguments
(if proc-search-result
(apply proc-search-result args-lst)
(error 'overload "failed because procedure ~a can not be applied to arguments list ~a" proc args-lst)))
(hash-table-set! $ovrld-ht$ proc '())))))
it works for overloading new procedure:
;; > (define-overload-procedure area)
;; > (define (area-square x) (* x x))
;; > (area-square 4)
;; 16
;; > (hash-table->alist $ovrld-ht$)
;; '((#<procedure:area>))
;; > (overload area area-square (number?))
;; > (hash-table->alist $ovrld-ht$)
;; '((#<procedure:area> ((#<procedure:number?>) #<procedure:area-square>)))
;; > (area 2)
;; 4
;; > (define (area-rectangle x y) (* x y))
;; > (overload area area-rectangle (number? number?))
;; > (area 2 5)
;; 10
but fails with existing one, for example if i try to overload length ,which already exist in Scheme ,to works both for list and vector:
(define-overload-existing-procedure length)
> (overload length vector-length (vector?))
> (length #(1 2 3 4))
#<procedure:length>
((#<procedure:length> ((#<procedure:vector?>) #<procedure:vector-length>)))
. . ../../Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/included-files/overload.scm:382:26: hash-table-ref: no value associated with #<procedure:length>
> (hash-table-ref $ovrld-ht$ length)
'(((#<procedure:vector?>) #<procedure:vector-length>))
> (hash-table->alist $ovrld-ht$)
'((#<procedure:length> ((#<procedure:vector?>) #<procedure:vector-length>)))
the problem come from here:
(define proc-lst (hash-table-ref ovrld-ht proc))
in define-overload-existing-procedure
the hash-table seems to have a key for length , (in fact #procedure:length, but is it the old one or the overloaded one? are they the same?
it can not find the value for the key, indeed all seems fine in hash table
note: i hope the code is complete to test for the one who can help
forget my last post, i find the bug, it was again one of my silly misunderstanding of macro steps.
i think the problem is solved by quoting the key in hash table, then the value is always retrieved ,even when the procedure which is the key is overloaded . The problem was hard to find because the displayed procedure remains always the same but i suppose the procedures are different at some steps. This causing the no value error for this different key than the one initialised.
this version corrects the errors:
(define-syntax overload-procedure
(syntax-rules ()
((_ orig-funct funct (pred-arg1 ...))
(let* ((qorig-funct (quote orig-funct))
(ovrld-lst (hash-table-ref $ovrld-ht$ qorig-funct)))
(display qorig-funct) (newline)
(hash-table-set! $ovrld-ht$ qorig-funct
(cons (list (list pred-arg1 ...) ;; example: ((number? string?) (lambda (n s) (display n) (display s) (newline)))
funct)
ovrld-lst))))))
(define-syntax define-overload-existing-procedure
(syntax-rules ()
((_ proc)
(begin
(define-syntax orig-proc (make-rename-transformer (syntax proc)))
;; (require (rename-in racket/base (proc
;; orig-proc)))
(define qproc (quote proc))
(define (proc . args-lst)
(display proc) (newline)
(define ht (hash-table->alist $ovrld-ht$))
(display ht) (newline)
(define proc-lst (hash-table-ref $ovrld-ht$ qproc)) ;; example: ((number? string?) (lambda (n s) (display n) (display s) (newline)))
;;(display proc-lst)
;;(newline)
(define (check-args-lst pred-list) ; check arguments list match predicates
(check-arguments pred-list args-lst))
(define (test-proc pred-proc-list) ; test the procedure if it matches with arguments
(if (check-args-lst (car pred-proc-list))
(car (cdr pred-proc-list))
#f))
(define proc-search-result (ormap test-proc proc-lst)) ; search for a procedure matching arguments
(if proc-search-result
(apply proc-search-result args-lst)
(apply orig-proc args-lst)))
(hash-table-set! $ovrld-ht$ qproc '())))))
(define-syntax define-overload-procedure
(syntax-rules ()
((_ proc)
(begin
(define qproc (quote proc))
(define (proc . args-lst)
(define proc-lst (hash-table-ref $ovrld-ht$ qproc)) ;; example: ((number? string?) (lambda (n s) (display n) (display s) (newline)))
;;(display proc-lst)
;;(newline)
(define (check-args-lst pred-list) ; check arguments list match predicates
(check-arguments pred-list args-lst))
(define (test-proc pred-proc-list) ; test the procedure if it matches with arguments
(if (check-args-lst (car pred-proc-list))
(car (cdr pred-proc-list))
#f))
(define proc-search-result (ormap test-proc proc-lst)) ; search for a procedure matching arguments
(if proc-search-result
(apply proc-search-result args-lst)
(error 'overload "failed because procedure ~a can not be applied to arguments list ~a" qproc args-lst)))
(hash-table-set! $ovrld-ht$ qproc '())))))
here is an example overloading length for vector and string :
(define-overload-existing-procedure length)
> (overload length vector-length (vector?))
> (length #(1 2 3 4))
4
> (length '(1 2 3))
3
> (overload length string-length (string?))
length
> (length "abcde")
5
>
note that i find an another way to "rename" a procedure:
make-rename-transformer
(define-syntax define-overload-existing-procedure
(syntax-rules ()
((_ proc)
(begin
(define-syntax orig-proc (make-rename-transformer (syntax proc)))
;; (require (rename-in racket/base (proc
;; orig-proc)))