From 7fc601d33c2d8617ddae6072d41074811fa106e5 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Mon, 18 Aug 2025 09:18:58 +0200 Subject: [PATCH] Changes -> and -! to %-> and %-!, because of too many name clashes in racket for ->. --- class.rkt | 12 ++--- main.rkt | 98 ++++++++++++++++++++--------------------- scribblings/class.scrbl | 20 ++++----- scribblings/roos.scrbl | 54 +++++++++++------------ 4 files changed, 92 insertions(+), 92 deletions(-) diff --git a/class.rkt b/class.rkt index a3b36d6..1636f15 100644 --- a/class.rkt +++ b/class.rkt @@ -1,29 +1,29 @@ #lang racket (require (rename-in racket/class [send old-send] [new old-new])) -(require (for-syntax (rename-in roos [-> old->]))) -(require (rename-in roos [-> old->])) +(require (for-syntax (rename-in roos [%-> old->]))) +(require (rename-in roos [%-> old->])) (provide (all-from-out roos) (all-from-out racket/class) - -> send new + %-> send new ) (define-syntax send (syntax-rules () ((_ obj method) (if (roos-object? obj) - (-> obj method) + (old-> obj method) (old-send obj method))) ((_ obj method a ...) (if (roos-object? obj) - (-> obj method a ...) + (old-> obj method a ...) (old-send obj method a ...))) )) -(define-syntax -> +(define-syntax %-> (syntax-rules () ((_ obj method) (if (roos-object? obj) diff --git a/main.rkt b/main.rkt index 9663924..b6ef72e 100644 --- a/main.rkt +++ b/main.rkt @@ -7,10 +7,10 @@ (require finalizer) (provide def-roos - -! + %-! roos-new - -> - ->> + %-> + %->> roos-class? roos-object? @@ -37,7 +37,7 @@ (define (@@cache-get obj var default) (let ((cl-hash (hash-ref @@storage@@ (roos-classname obj) (make-hasheq)))) - (let ((id (-> obj roos-id))) + (let ((id (%-> obj roos-id))) (let ((obj-hash (hash-ref cl-hash id (make-hasheq)))) (hash-ref obj-hash var default))))) @@ -46,7 +46,7 @@ (unless cl-hash (set! cl-hash (make-hasheq)) (hash-set! @@storage@@ (roos-classname obj) cl-hash)) - (let ((id (-> obj roos-id))) + (let ((id (%-> obj roos-id))) (let ((obj-hash (hash-ref cl-hash id #f))) (unless obj-hash (set! obj-hash (make-hasheq)) @@ -58,7 +58,7 @@ (define (@@cache-delete! obj) (unless @@stop-deleting@@ (let ((cl-hash (hash-ref @@storage@@ (roos-classname obj) (make-hasheq)))) - (hash-remove! cl-hash (-> obj roos-id))))) + (hash-remove! cl-hash (%-> obj roos-id))))) (define (@@cache-stop-deleting yn) (set! @@stop-deleting@@ yn)) @@ -610,7 +610,7 @@ ((_ cl . args) (roos-class*-closure cl)))) -(define-syntax -! +(define-syntax %-! (syntax-rules () ((_ cl) (if (roos-class*? cl) @@ -625,7 +625,7 @@ (define-syntax roos-new (syntax-rules () ((_ cl ...) - (-! cl ...)))) + (%-! cl ...)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Calling methods / attributes @@ -645,7 +645,7 @@ (@@is-supers*? objs)) #f)) -(define-syntax ->> +(define-syntax %->> (syntax-rules () ((_ obj f) (if (roos-object*? obj) @@ -666,7 +666,7 @@ (define-syntax with-roos-obj (syntax-rules () ((_ obj (m1 ...) body ...) - (let* ((m1 (->> obj m1)) + (let* ((m1 (%->> obj m1)) ...) body ...)))) @@ -704,7 +704,7 @@ (caller 'f a ...)) )) -(define-syntax -> +(define-syntax %-> (syntax-rules () ((_ obj f ...) (if (roos-object*? obj) @@ -722,10 +722,10 @@ (define roos-class? roos-class*?) (define (roos-id obj) - (-> obj roos-id)) + (%-> obj roos-id)) (define (roos-id! obj id) - (-> obj roos-id! id)) + (%-> obj roos-id! id)) (define (roos-class cl-obj) (if (roos-object*? cl-obj) @@ -944,36 +944,36 @@ (test-case "Simple ROOS declaration and usage" (def-roos (t1) this (supers) (a 10)) - (let ((obj (-! t1))) - (check-true (= (-> obj a) 10)) - (-> obj a! 12) - (check-true (= (-> obj a) 12))) + (let ((obj (%-! t1))) + (check-true (= (%-> obj a) 10)) + (%-> obj a! 12) + (check-true (= (%-> obj a) 12))) ) (test-case "ROOS declaration with supers" (def-roos (a x) this (supers) (y (+ x 4)) - ((g a) (* a (-> this y)))) + ((g a) (* a (%-> this y)))) (def-roos (b) this (supers (roos-new a 2)) (y 55) ;("The v function gets and sets the y member of the super object of class a" ((v . a) (if (null? a) - (-> supers y) + (%-> supers y) (begin - (-> supers y! (car a)) - (-> supers y)))) + (%-> supers y! (car a)) + (%-> supers y)))) ;) ) (let ((bb (roos-new b))) - (tst (= (-> bb y) 55)) - (tst (= (-> bb g 2) 110)) - (tst (= (-> bb v) 6)) - (tst (= (-> bb v 10) 10)) - (tst (= (-> bb g 3) 165)) - (tst (= (-> bb y! 10) 10)) - (tst (= (-> bb g 2) 20))) + (tst (= (%-> bb y) 55)) + (tst (= (%-> bb g 2) 110)) + (tst (= (%-> bb v) 6)) + (tst (= (%-> bb v 10) 10)) + (tst (= (%-> bb g 3) 165)) + (tst (= (%-> bb y! 10) 10)) + (tst (= (%-> bb g 2) 20))) ) (test-case @@ -996,40 +996,40 @@ (cons (list a b) d)) ("f11-doc" ((f11 a b c d e . h) (cons (* a b c d e) h))) ) - (let ((o (-! decl))) - (tst (= (-> o a1) 1)) - (tst (begin (-> o a1! 33) (= (-> o a1) 33))) - (tst (symbol? (-> o roos-id))) - (tst (begin (printf "roos-id: ~a " (-> o roos-id)) #t) "Displaying roos id of object") - (tst (eq? (-> o roos-id! 'my-id) 'my-id)) - (tst (begin (printf "roos-id: ~a " (-> o roos-id)) #t) "Displaying roos id of object after set") - (-> o a2! 99) - (tst (= (-> o a2) 99)) + (let ((o (%-! decl))) + (tst (= (%-> o a1) 1)) + (tst (begin (%-> o a1! 33) (= (%-> o a1) 33))) + (tst (symbol? (%-> o roos-id))) + (tst (begin (printf "roos-id: ~a " (%-> o roos-id)) #t) "Displaying roos id of object") + (tst (eq? (%-> o roos-id! 'my-id) 'my-id)) + (tst (begin (printf "roos-id: ~a " (%-> o roos-id)) #t) "Displaying roos id of object after set") + (%-> o a2! 99) + (tst (= (%-> o a2) 99)) (tst (begin (printf "storage: ~a " @@storage@@) #t)) (tst (= (hash-ref (hash-ref (hash-ref @@storage@@ 'decl) 'my-id ) 'a2) 99)) - (let ((o1 (-! decl))) - (tst (eq? (-> o1 roos-id! 'my-id) 'my-id) "Don't do this at home: giving new object same id as existing object") - (tst (begin (printf "o1 -> a2: ~a " (-> o1 a2)) #t) "a2 = o1 -> a2") - (tst (= (-> o1 a2) (-> o a2))) - (tst (equal? (-> o1 a2! "hoi") "hoi")) - (tst (string=? (-> o a2) "hoi")) + (let ((o1 (%-! decl))) + (tst (eq? (%-> o1 roos-id! 'my-id) 'my-id) "Don't do this at home: giving new object same id as existing object") + (tst (begin (printf "o1 %-> a2: ~a " (%-> o1 a2)) #t) "a2 = o1 %-> a2") + (tst (= (%-> o1 a2) (%-> o a2))) + (tst (equal? (%-> o1 a2! "hoi") "hoi")) + (tst (string=? (%-> o a2) "hoi")) ) (collect-garbage) - (tst (= (-> o a2) 2) "After collection of o1, o will be deleted from storage") + (tst (= (%-> o a2) 2) "After collection of o1, o will be deleted from storage") ) (def-roos (t1) this (supers) (x 8)) (def-roos (t2 a) this (supers) (x a)) - (tst (= (-> (-! t2 5) x) 5)) + (tst (= (%-> (%-! t2 5) x) 5)) (def-roos (t3 . a) this (supers) ((f y) (map (lambda (x) (* x y)) a))) - (tst (equal? (-> (-! t3 4 5 6) f 2) '(8 10 12))) - (def-roos (t4 a b c . d) this (supers (-! t3 a b c)) + (tst (equal? (%-> (%-! t3 4 5 6) f 2) '(8 10 12))) + (def-roos (t4 a b c . d) this (supers (%-! t3 a b c)) ((g y) (cons (map (lambda (x) (+ x y)) - (-> supers f y)) (map (lambda (x) (* x y)) d))) + (%-> supers f y)) (map (lambda (x) (* x y)) d))) ) - (tst (let ((r (-> (-! t4 2 3 4 12 13) g 2)) + (tst (let ((r (%-> (%-! t4 2 3 4 12 13) g 2)) (R '((6 8 10) 24 26))) (equal? r R))) diff --git a/scribblings/class.scrbl b/scribblings/class.scrbl index 2bbef46..9e3da68 100644 --- a/scribblings/class.scrbl +++ b/scribblings/class.scrbl @@ -14,13 +14,13 @@ @defmodule[roos/class] -This module provides a compatibility layer between the @seclink["roos" #:doc '(lib "roos/scribblings/roos.scrbl") ]{@racketmodname[roos]} object system and the standard @racketmodname[racket/class] system. It exports the macros @racket[send], @racket[->], and @racket[new], which automatically dispatch to the appropriate implementation based on the type of the given object or class. +This module provides a compatibility layer between the @seclink["roos" #:doc '(lib "roos/scribblings/roos.scrbl") ]{@racketmodname[roos]} object system and the standard @racketmodname[racket/class] system. It exports the macros @racket[send], @racket[%->], and @racket[new], which automatically dispatch to the appropriate implementation based on the type of the given object or class. @section{Macros} @defidform[send]{(send obj method arg ...) A generic message-send macro that works for both Roos objects and standard Racket class objects. -If @racket[obj] is a Roos object (@racket[roos-object?]), it uses the Roos dispatch (@racket[->]). +If @racket[obj] is a Roos object (@racket[roos-object?]), it uses the Roos dispatch (@racket[%->]). Otherwise, it falls back to the original @racket[send] from @racket[racket/class].} @examples[ @@ -32,7 +32,7 @@ Otherwise, it falls back to the original @racket[send] from @racket[racket/class (send o f 2) ; → 10 ] -@defidform[->]{(-> obj method arg ...) +@defidform[%->]{(%-> obj method arg ...) An alternative method dispatch macro. The syntax omits the explicit @racket[send] and may feel more familiar to users of other programming languages that use concise or operator-based method invocation. This macro checks whether @racket[obj] is a Roos object or a standard Racket object and dispatches accordingly.} @@ -43,7 +43,7 @@ This macro checks whether @racket[obj] is a Roos object or a standard Racket obj (y x) ((f a) (* a x))) (define o (new t 5)) -(-> o f 3) ; → 15 +(%-> o f 3) ; → 15 ] @subsection{Comparison with other languages} @@ -56,7 +56,7 @@ In other languages, method invocation often uses compact notation: @item{C++: @tt{obj->method(args)} or @tt{obj.method(args)}} ] -The @racket[->] macro serves a similar role within the s-expression syntax of Racket. +The @racket[%->] macro serves a similar role within the s-expression syntax of Racket. @defidform[new]{(new class arg ...) Creates a new object. If @racket[class] is a Roos class (@racket[roos-class?]), then @racket[roos-new] is used. @@ -77,7 +77,7 @@ Otherwise, the standard @racket[new] from @racket[racket/class] is used, support (def-roos (t x) this (supers) (y x) - ((f a) (* (-> this y) a)) + ((f a) (* (%-> this y) a)) ) (displayln @@ -88,11 +88,11 @@ Otherwise, the standard @racket[new] from @racket[racket/class] is used, support (displayln (let ((cl (t% 6))) (let ((o (new cl))) - (= (-> o f 3) 18)))) + (= (%-> o f 3) 18)))) (displayln (let ((o (new t 8))) - (= (-> o f 4) 32))) + (= (%-> o f 4) 32))) (displayln (= (send (new t 4) f 2) 8)) @@ -101,7 +101,7 @@ Otherwise, the standard @racket[new] from @racket[racket/class] is used, support @section{Implementation Notes} @itemlist[ - @item{The original Racket @racket[send] and @racket[->] are renamed to @racket[old-send] and @racket[old->] internally.} + @item{The original Racket @racket[send] and @racket[%->] are renamed to @racket[old-send] and @racket[old->] internally.} @item{The Roos-aware macros detect the object or class type and route to the correct implementation.} @item{@racket[new*] is a helper macro that transforms arguments into @racket[(v x)] form when needed.} ] @@ -109,7 +109,7 @@ Otherwise, the standard @racket[new] from @racket[racket/class] is used, support @section{Testing} The module includes an internal test suite using RackUnit. -It validates consistent behavior of @racket[send], @racket[->], and @racket[new] across both Racket classes and Roos classes. +It validates consistent behavior of @racket[send], @racket[%->], and @racket[new] across both Racket classes and Roos classes. @; End of documentation diff --git a/scribblings/roos.scrbl b/scribblings/roos.scrbl index 1640ab5..eae3b21 100644 --- a/scribblings/roos.scrbl +++ b/scribblings/roos.scrbl @@ -49,10 +49,10 @@ Methods and fields are always virtual. Superclass definitions are resolved based @section{Object and Method Use} @itemlist[ - @item{@racket[(-> obj field)] — call getter for field.} - @item{@racket[(-> obj field! val)] — set field.} - @item{@racket[(-> obj method args ...)] — invoke method.} - @item{@racket[(->> obj name)] — retrieve method/field procedure.} + @item{@racket[(%-> obj field)] — call getter for field.} + @item{@racket[(%-> obj field! val)] — set field.} + @item{@racket[(%-> obj method args ...)] — invoke method.} + @item{@racket[(%->> obj name)] — retrieve method/field procedure.} @item{@racket[(roos-object? x)] — is it a ROOS object?} @item{@racket[(roos-class? x)] — is it a ROOS class definition?} @item{@racket[(roos-classname obj)] — symbolic class name.} @@ -63,11 +63,11 @@ Methods and fields are always virtual. Superclass definitions are resolved based @subsection{Provided procedures} -@defproc[(-> [obj any/c] [name symbol?] ...) any/c]{ +@defproc[(%-> [obj any/c] [name symbol?] ...) any/c]{ Invoke a getter, setter, or method on ROOS object @racket[obj] using name and arguments. } -@defproc[(->> [obj any/c] [name symbol?]) procedure?]{ +@defproc[(%->> [obj any/c] [name symbol?]) procedure?]{ Return the method or field procedure named @racket[name] from object @racket[obj]. Useful for higher-order usage. } @@ -105,7 +105,7 @@ Constructs a new ROOS object of the given @racket[class], optionally with argume If the class defines @racket[init], that method is invoked automatically. } -@defproc[(-! [class any/c] [args any/c] ...) any/c]{ +@defproc[(%-! [class any/c] [args any/c] ...) any/c]{ Convenient shorthand for @racket[roos-new]. Also invokes @racket[init] if present. } @@ -236,12 +236,12 @@ This example builds an address book with persistent reference to persons, using ((add p) (set! persons (vector-extend persons (+ (vector-length persons) 1) p)) - (-> this ids! (vector->list (vector-map (lambda (o) (-> o roos-id)) persons)))) + (%-> this ids! (vector->list (vector-map (lambda (o) (%-> o roos-id)) persons)))) ((remove i) (set! persons (vector-append (vector-take persons i) (vector-drop persons (+ i 1)))) - (-> this ids! (vector->list - (vector-map (lambda (o) (-> o roos-id)) persons)))) + (%-> this ids! (vector->list + (vector-map (lambda (o) (%-> o roos-id)) persons)))) ((for-each f) (letrec ((g (lambda (i n) @@ -251,34 +251,34 @@ This example builds an address book with persistent reference to persons, using (g 0 (vector-length persons)))) (init (begin - (-> this roos-id! 'book) + (%-> this roos-id! 'book) (let ((ps (map (lambda (id) (let ((p (roos-new person))) - (-> p roos-id! id) + (%-> p roos-id! id) p)) - (-> this ids)))) + (%-> this ids)))) (set! persons (list->vector ps))))) ) ;; Create sample data -(define b (-! book)) +(define b (%-! book)) (define (adder n t) - (let ((p (-! person))) - (-> p name! n) - (-> p tel! t) - (-> b add p))) + (let ((p (%-! person))) + (%-> p name! n) + (%-> p tel! t) + (%-> b add p))) (adder "Alice" "123") (adder "Bob" "456") (adder "Jos" "982") (adder "Rebecca" "363") -(-> b (for-each (lambda (p) (displayln (-> p name))))) +(%-> b (for-each (lambda (p) (displayln (%-> p name))))) ;; Reopen addressbook later from persistent storage -(define a (-! book)) -(-> b (for-each (lambda (p) (displayln (-> p name))))) +(define a (%-! book)) +(%-> b (for-each (lambda (p) (displayln (%-> p name))))) ] @@ -295,14 +295,14 @@ For example, a doubly-linked list: (next #f) (prev #f)) -(define a (-! node)) -(-> a val! 1) +(define a (%-! node)) +(%-> a val! 1) -(define b (-! node)) -(-> b val! 2) +(define b (%-! node)) +(%-> b val! 2) -(-> a next! b) -(-> b prev! a) +(%-> a next! b) +(%-> b prev! a) ] To avoid resource leaks when such cyclic structures are finalized, make sure that any cleanup (e.g. persistence flush) is done in @racket[finalize] methods. Racket's garbage collector can collect cyclic references if there are no external references left.