⚝
One Hat Cyber Team
⚝
Your IP:
216.73.216.23
Server IP:
178.33.27.10
Server:
Linux cpanel.dev-unit.com 3.10.0-1160.108.1.el7.x86_64 #1 SMP Thu Jan 25 16:17:31 UTC 2024 x86_64
Server Software:
Apache/2.4.57 (Unix) OpenSSL/1.0.2k-fips
PHP Version:
8.2.11
Buat File
|
Buat Folder
Eksekusi
Dir :
~
/
usr
/
share
/
guile
/
2.0
/
oop
/
goops
/
View File Name :
active-slot.scm
;;; installed-scm-file ;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc. ;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. ;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; ;;;; ;;;; This file was based upon active-slot.stklos from the STk distribution ;;;; version 4.0.1 by Erick Gallesio <eg@unice.fr>. ;;;; (define-module (oop goops active-slot) :use-module (oop goops internal) :export (<active-class>)) (define-class <active-class> (<class>)) (define-method (compute-get-n-set (class <active-class>) slot) (if (eq? (slot-definition-allocation slot) #:active) (let* ((index (slot-ref class 'nfields)) (s (cdr slot)) (before-ref (get-keyword #:before-slot-ref s #f)) (after-ref (get-keyword #:after-slot-ref s #f)) (before-set! (get-keyword #:before-slot-set! s #f)) (after-set! (get-keyword #:after-slot-set! s #f)) (unbound (make-unbound))) (slot-set! class 'nfields (+ index 1)) (list (lambda (o) (if before-ref (if (before-ref o) (let ((res (%fast-slot-ref o index))) (and after-ref (not (eqv? res unbound)) (after-ref o)) res) (make-unbound)) (let ((res (%fast-slot-ref o index))) (and after-ref (not (eqv? res unbound)) (after-ref o)) res))) (lambda (o v) (if before-set! (if (before-set! o v) (begin (%fast-slot-set! o index v) (and after-set! (after-set! o v)))) (begin (%fast-slot-set! o index v) (and after-set! (after-set! o v))))))) (next-method)))