Changeset 35141 in project


Ignore:
Timestamp:
02/17/18 19:30:06 (10 months ago)
Author:
kon
Message:

complete define:-record-type

Location:
release/4/dsssl-utils/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/dsssl-utils/trunk/tests/run.scm

    r34790 r35141  
    7777)
    7878
     79(test-group "typed-define-record"
     80
     81  (define:-record-type <trec>
     82    (make-trec a b c)
     83    trec?
     84    (a string trec-a)
     85    (b (or boolean number) trec-b trec-b-set!)
     86    (c immediate trec-c trec-c-set!) )
     87
     88  (let ((trec (make-trec "a" #f #!eof)))
     89    (test-assert (trec? trec))
     90    (test #f (trec-b trec))
     91    (trec-b-set! trec 34)
     92    (test 34 (trec-b trec)) )
     93)
     94
    7995;;
    8096
  • release/4/dsssl-utils/trunk/typed-define.scm

    r34913 r35141  
    66(;export
    77  define:-record-type
    8   define:
    9 )
     8  define:)
    109
    11 (import scheme)
     10(import scheme chicken)
    1211
    1312;; typed scheme
     
    1514(define-syntax define:-record-type
    1615  (syntax-rules ()
    17     ((_ ?tag (?ctor-id ?ctor-args ...) ?pred-id ?feld-specs ...)
     16    ((_ ?tag (?ctor-id ?ctor-args ...) ?pred-id (?feld-var ?feld-typ ?feld-ref ...) ...)
    1817      (begin
    1918        (: ?ctor-id (#!rest --> (struct ?tag)))
    20         (: ?pred-id (* --> boolean))
     19        (: ?pred-id (* -> boolean : (struct ?tag)))
     20        (type:-record-type-accessor ?tag (?feld-var ?feld-typ ?feld-ref ...)) ...
    2121        ;build type-dict from ?ctor-args ...
    2222        (define-record-type ?tag
    2323          (?ctor-id ?ctor-args ...)
    2424          ?pred-id
    25           ?feld-specs ...) ) ) ) )
     25          (?feld-var ?feld-ref ...) ...) ) ) ) )
    2626
    2727(define-syntax define:
     
    5959    ;
    6060    ((_ (?name) ?body ...)
    61       (define: (?name) -> void
     61      (define: (?name) -> undefined
    6262        ?body ...) )
    6363    ;
    6464    ((_ (?name (?v ?t) ...) ?body ...)
    65       (define: (?name (?v ?t) ...) -> void
     65      (define: (?name (?v ?t) ...) -> undefined
    6666        ?body ...) )
    6767    ;
    6868    ((_ (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) ?body ...)
    69       (define: (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) -> void
     69      (define: (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) -> undefined
    7070        ?body ...) ) ) )
     71
     72;;
     73
     74(define-syntax type:-record-type-accessor
     75  (syntax-rules ()
     76    ;
     77    ((_ ?tag (?var ?typ ?ref))
     78      (: ?ref ((struct ?tag) --> ?typ)) )
     79    ;
     80    ((_ ?tag (?var ?typ ?ref ?set))
     81      (begin
     82        (: ?ref ((struct ?tag) --> ?typ))
     83        (: ?set ((struct ?tag) ?typ -> undefined)) ) ) ) )
    7184
    7285;typed scheme support
Note: See TracChangeset for help on using the changeset viewer.