Changes -> and -! to %-> and %-!, because of too many name clashes in racket for ->.

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 (for-syntax (rename-in roos [%-> old->])))
-(require (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)

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)))
+   (let ((obj (%-! t1)))
-     (check-true (= (-> obj a) 10))
+     (check-true (= (%-> obj a) 10))
-     (-> obj a! 12)
+     (%-> obj a! 12)
-     (check-true (= (-> 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! (car a))
-             (-> supers y))))
+             (%-> supers y))))
      ;)
      )
    (let ((bb (roos-new b)))
-     (tst (= (-> bb y) 55))
+     (tst (= (%-> bb y) 55))
-     (tst (= (-> bb g 2) 110))
+     (tst (= (%-> bb g 2) 110))
-     (tst (= (-> bb v) 6))
+     (tst (= (%-> bb v) 6))
-     (tst (= (-> bb v 10) 10))
+     (tst (= (%-> bb v 10) 10))
-     (tst (= (-> bb g 3) 165))
+     (tst (= (%-> bb g 3) 165))
-     (tst (= (-> bb y! 10) 10))
+     (tst (= (%-> bb y! 10) 10))
-     (tst (= (-> bb g 2) 20)))
+     (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)))
+   (let ((o (%-! decl)))
-     (tst (= (-> o a1) 1))
+     (tst (= (%-> o a1) 1))
-     (tst (begin (-> o a1! 33) (= (-> o a1) 33)))
+     (tst (begin (%-> o a1! 33) (= (%-> o a1) 33)))
-     (tst (symbol? (-> o roos-id)))
+     (tst (symbol? (%-> o roos-id)))
-     (tst (begin (printf "roos-id: ~a " (-> o roos-id)) #t) "Displaying roos id of object")
+     (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 (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")
+     (tst (begin (printf "roos-id: ~a " (%-> o roos-id)) #t) "Displaying roos id of object after set")
-     (-> o a2! 99)
+     (%-> o a2! 99)
-     (tst (= (-> 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)))
+     (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 (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 (begin (printf "o1 %-> a2: ~a " (%-> o1 a2)) #t) "a2 = o1 %-> a2")
-       (tst (= (-> o1 a2) (-> o a2)))
+       (tst (= (%-> o1 a2) (%-> o a2)))
-       (tst (equal? (-> o1 a2! "hoi") "hoi"))
+       (tst (equal? (%-> o1 a2! "hoi") "hoi"))
-       (tst (string=? (-> o a2) "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)))
+   (tst (equal? (%-> (%-! t3 4 5 6) f 2) '(8 10 12)))
-   (def-roos (t4 a b c . d) this (supers (-! t3 a b c))
+   (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)))
                        

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

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)] — call getter for field.}
- @item{@racket[(-> obj field! val)] — set field.}
+ @item{@racket[(%-> obj field! val)] — set field.}
- @item{@racket[(-> obj method args ...)] — invoke method.}
+ @item{@racket[(%-> obj method args ...)] — invoke method.}
- @item{@racket[(->> obj name)] — retrieve method/field procedure.}
+ @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
+   (%-> this ids! (vector->list
-                    (vector-map (lambda (o) (-> o roos-id)) persons))))
+                    (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)))
+  (let ((p (%-! person)))
-    (-> p name! n)
+    (%-> p name! n)
-    (-> p tel! t)
+    (%-> p tel! t)
-    (-> b add p)))
+    (%-> 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))
+(define a (%-! book))
-(-> b (for-each (lambda (p) (displayln (-> p name)))))
+(%-> 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))
+(define a (%-! node))
-(-> a val! 1)
+(%-> a val! 1)
 
-(define b (-! node))
+(define b (%-! node))
-(-> b val! 2)
+(%-> b val! 2)
 
-(-> a next! b)
+(%-> a next! b)
-(-> b prev! a)
+(%-> 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.