Ticket #1581: record-tag-fun.diff

File record-tag-fun.diff, 6.9 KB (added by felix winkelmann, 5 years ago)

Patches for coops, record-variants

  • coops/trunk/coops-module.scm

     
    1313               slot-initialized?
    1414               <standard-class>
    1515               <standard-object>
     16               coops-instance
    1617               make
    1718               make-class
    1819               generic-procedure?

  • coops/trunk/coops.egg

     
    44 (author "Dorai Sitaram and felix winkelmann")
    55 (dependencies matchable miscmacros record-variants srfi-1)
    66 (test-dependencies test)
    7  (components (extension coops (source "coops-module.scm"))
     7 (components (extension coops
     8                        (source "coops-module.scm")
     9                        (source-dependencies "coops.scm"))
    810             (extension coops-primitive-objects (component-dependencies coops))))

  • coops/trunk/coops.scm

     
    1414        (only miscmacros ensure))
    1515(import-for-syntax matchable (chicken plist) srfi-1)
    1616
     17;; this will be overridden
     18(define-record coops-instance class slots)
     19
    1720(define-record-variant coops-instance (unsafe inline unchecked)
    1821  class                                 ; CLASS (instance)
    1922  slots)                                ; #(SLOT-VALUE1 ...)
    … …  
    3235  (set! method-definition-counter (fx+ method-definition-counter 1)))
    3336
    3437(define-inline (check-instance x loc)
    35   (##sys#check-structure x 'coops-instance loc))
     38  (##sys#check-structure x coops-instance loc))
    3639
    3740(define <standard-class>
    3841  ;;all classes are instances of standard-class
    … …  
    157160      (primitive-class-hook o)))
    158161
    159162(define-inline (fast-class-of o)
    160   (if (##sys#structure? o 'coops-instance)
     163  (if (##sys#structure? o coops-instance)
    161164      (##sys#slot o 1)
    162165      (primitive-class-hook o)))
    163166

  • record-variants/trunk/record-variants.scm

     
    100100                `(,%define
    101101                  ,(string->symbol (string-append "make-" prefix))
    102102                  (,%lambda ,slots
    103                             (##sys#make-structure ',original-name ,@slots)))
     103                            (##sys#make-structure ,original-name ,@slots)))
    104104                `(,%begin))
    105105           (,%define
    106106            ,(string->symbol (string-append prefix "?"))
    107             (,%lambda (x) (##sys#structure? x ',original-name)))
     107            (,%lambda (x) (##sys#structure? x ,original-name)))
    108108           (,%define
    109109            ,(string->symbol (string-append "check-" prefix))
    110110            (,%lambda (x)
    111                       (##core#check (##sys#check-structure x ',original-name))
     111                      (##core#check (##sys#check-structure x ,original-name))
    112112                      x))
    113113           ,@(let loop ((slots slots) (i 1))
    114114               (if (eq? slots '())
    … …  
    126126                                   ,(if unchecked?
    127127                                        `(,%begin)
    128128                                        `(##core#check (##sys#check-structure
    129                                                         x ',original-name)))
     129                                                        x ,original-name)))
    130130                                   ,(if unsafe?
    131131                                        `(##sys#setslot x ,i val)
    132132                                        `(##sys#block-set! x ,i val))))
    … …  
    138138                                          ,(if unchecked?
    139139                                               `(,%begin)
    140140                                               `(##core#check (##sys#check-structure
    141                                                                x ',original-name)))
     141                                                               x ,original-name)))
    142142                                          ,(if unsafe?
    143143                                               `(##sys#slot x ,i)
    144144                                               `(##sys#block-ref x ,i)))
    … …  
    147147                                         ,(if unchecked?
    148148                                              `(,%begin)
    149149                                              `(##core#check (##sys#check-structure
    150                                                               x ',original-name)))
     150                                                              x ,original-name)))
    151151                                         ,(if unsafe?
    152152                                              `(##sys#slot x ,i)
    153153                                              `(##sys#block-ref x ,i))))))
    … …  
    192192           ,(if constructor?
    193193                `(,%define ,conser
    194194                           (##sys#make-structure
    195                             ',t
     195                            ,t
    196196                            ,@(map (lambda (sname)
    197197                                     (if (memq sname vars)
    198198                                         sname
    … …  
    199199                                         '(##core#undefined)))
    200200                                   slotnames)))
    201201                `(,%begin))
    202            (,%define (,pred ,x) (##sys#structure? ,x ',t))
     202           (,%define (,pred ,x) (##sys#structure? ,x ,t))
    203203           ,(if checker
    204204                `(,%define (,checker ,x)
    205                            (##core#check (##sys#check-structure ,x ',t)))
     205                           (##core#check (##sys#check-structure ,x ,t)))
    206206                `(,%begin))
    207207           ,@(let loop ([slots slots] [i 1])
    208208               (if (null? slots)
    … …  
    214214                                           ,(if unchecked?
    215215                                                `(,%begin)
    216216                                                `(##core#check
    217                                                   (##sys#check-structure ,x ',t)))
     217                                                  (##sys#check-structure ,x ,t)))
    218218                                           ,(if unsafe?
    219219                                                `(##sys#slot ,x ,i)
    220220                                                `(##sys#block-ref ,x ,i)))))
    … …  
    223223                                         ,(if unchecked?
    224224                                              `(,%begin)
    225225                                              `(##core#check
    226                                                 (##sys#check-structure ,x ',t)))
     226                                                (##sys#check-structure ,x ,t)))
    227227                                         ,(if unsafe?
    228228                                              `(##sys#setslot ,x ,i ,y)
    229229                                              `(##sys#block-set! ,x ,i ,y))))