hans/roos
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Optimizations

Browse Source
This commit is contained in:
Hans Dijkema
2025-07-06 16:58:40 +02:00
parent 7456da3e5f
commit 6fa7f1b2c1
2 changed files with 20 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
info.rkt
View File

@@ -1,7 +1,7 @@
#lang info #lang info
(define pkg-authors '(hnmdijkema)) (define pkg-authors '(hnmdijkema))
(define version "0.54") (define version "0.55")
(define license 'Apache-2.0) (define license 'Apache-2.0)
(define collection "roos") (define collection "roos")
(define pkg-desc "An OO Framework for Racket") (define pkg-desc "An OO Framework for Racket")

26
main.rkt
View File

@@ -25,14 +25,14 @@
;; Persistance helpers ;; Persistance helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define @storage@ (make-hash)) (define @storage@ (make-hasheq))
(define (cache-get id symbol) (define (cache-get id symbol)
(let ((h (hash-ref @storage@ id))) (let ((h (hash-ref @storage@ id)))
(hash-ref h symbol))) (hash-ref h symbol)))
(define (cache-set! id symbol val) (define (cache-set! id symbol val)
(let ((h (hash-ref @storage@ id (make-hash)))) (let ((h (hash-ref @storage@ id (make-hasheq))))
(hash-set! h symbol val) (hash-set! h symbol val)
(hash-set! @storage@ id h))) (hash-set! @storage@ id h)))
@@ -118,7 +118,7 @@
; (if (roos-class? cl) ; (if (roos-class? cl)
; ((cdr cl) a ...) ; ((cdr cl) a ...)
; (error "This is not a roos class"))))) ; (error "This is not a roos class")))))
(define-syntax -> (define-syntax ->
(syntax-rules () (syntax-rules ()
@@ -234,12 +234,24 @@
(hash-set! @roos@ '@roos-id@ (new-id)) (hash-set! @roos@ '@roos-id@ (new-id))
(hash-set! @roos@ '@set-roos-id@ (lambda (id) (hash-set! @roos@ '@set-roos-id@ (lambda (id)
(hash-set! @roos@ '@roos-id@ id))) (hash-set! @roos@ '@roos-id@ id)))
(define last-call #f)
(define last-func #f)
(define @supers-hash@ (make-hasheq))
(define self (cons 'roos-object (define self (cons 'roos-object
(lambda (f-name . args) (lambda (f-name . args)
(roos-call @roos@ (hash-ref @roos@ '@supers@) f-name args)))) (if (eq? last-call f-name)
(apply last-func args)
(let ((f (hash-ref @roos@ f-name #f)))
(if f
(begin
(set! last-call f-name)
(set! last-func f)
(apply f args))
(roos-call @roos@ (hash-ref @roos@ '@supers@) f-name args)))))
))
(define supers (cons 'roos-object (define supers (cons 'roos-object
(lambda (f-name . args) (lambda (f-name . args)
(roos-call (make-hash) (hash-ref @roos@ '@supers@) f-name args)))) (roos-call @supers-hash@ (hash-ref @roos@ '@supers@) f-name args))))
(hash-set! @roos@ '@roos@ (lambda () @roos@)) (hash-set! @roos@ '@roos@ (lambda () @roos@))
;(hash-set! @roos@ '@supers@ '()) ;(hash-set! @roos@ '@supers@ '())
(hash-set! @roos@ '@set-supers@ (lambda (s) (hash-set! @roos@ '@supers@ s))) (hash-set! @roos@ '@set-supers@ (lambda (s) (hash-set! @roos@ '@supers@ s)))
@@ -259,7 +271,7 @@
(syntax-rules (s) (syntax-rules (s)
((_ class classname self (supers) b ...) ((_ class classname self (supers) b ...)
(begin (begin
(define @roos@ (make-hash)) (define @roos@ (make-hasheq))
(hash-set! @roos@ '@supers@ '()) (hash-set! @roos@ '@supers@ '())
(init-roos-body @roos@ class classname self supers) (init-roos-body @roos@ class classname self supers)
(@@roos-def @roos@ b) (@@roos-def @roos@ b)
@@ -270,7 +282,7 @@
(let* ((s (list super-invokes ...)) (let* ((s (list super-invokes ...))
(obj (obj
(begin (begin
(let ((@roos@ (make-hash))) (let ((@roos@ (make-hasheq)))
(hash-set! @roos@ '@supers@ s) (hash-set! @roos@ '@supers@ s)
(init-roos-body @roos@ class classname self supers) (init-roos-body @roos@ class classname self supers)
(@@roos-def @roos@ b) (@@roos-def @roos@ b)