I'm not sure whether the following is a good idea, but it more or less works. The impersonate-struct function allows one to redirect the some or all of accessor and mutator functions on *individual struct instances*. If the actual constructor is hidden from the user and only a ``smart'' constructor is exported, then we can put impersonators on all struct instances.
#lang racket (provide smart-db-chunk-approach-1 smart-db-chunk-approach-2 (except-out (struct-out db-chunk) make-db-chunk)) (struct db-chunk (scratchdir-path chunkdir-path) #:mutable #:constructor-name make-db-chunk #:transparent ;; for impersonators ;; and perhaps guards ) ;; approach 1: save path-string? in struct fields and redirect accessors (define (smart-db-chunk-approach-1 . args) (impersonate-struct (apply make-db-chunk args) db-chunk-scratchdir-path (λ (chnk v) (if (path? v) (path->string v) v)) db-chunk-chunkdir-path (λ (chnk v) (if (path? v) (path->string v) v)))) (define s1 (smart-db-chunk-approach-1 (string->path "/usr") "/var")) (string? (db-chunk-scratchdir-path s1)) ;; approach 2: redirect mutators and only save string? in struct fields (define (smart-db-chunk-approach-2 . args) (impersonate-struct (apply make-db-chunk args) set-db-chunk-scratchdir-path! (λ (chnk v) (if (path? v) (path->string v) v)) set-db-chunk-chunkdir-path! (λ (chnk v) (if (path? v) (path->string v) v)))) (define s2 (smart-db-chunk-approach-2 "/usr" "/var")) (set-db-chunk-chunkdir-path! s2 (string->path "/bin")) (string? (db-chunk-scratchdir-path s2)) --Shu-Hung On Thu, Dec 7, 2017 at 10:10 AM, David Storrs <david.sto...@gmail.com> wrote: > Wow. Thank you, Matthias. That's impressive. > > On Thu, Dec 7, 2017 at 10:46 AM, Matthias Felleisen > <matth...@ccs.neu.edu> wrote: >> >> On Dec 6, 2017, at 10:45 PM, David Storrs <david.sto...@gmail.com> wrote: >> >> I have a struct that looks like this (simplified for concision): >> >> (struct db-chunk (scratchdir-path chunkdir-path) #:mutable) >> >> I'd like to ensure that: >> >> 1) At least one of the fields must be set at creation >> 2) Both fields will accept only a path-string? value >> 3) Both fields will return string? when accessed, as that makes it >> easier to insert into the DB when the time comes. >> >> I can put a #:guard parameter on db-chunk that will check #1 and #2 >> and (if necessary) transform the input into a string in order to >> satisfy #3, but that only works at initialization. From there I would >> need to redefine the mutator: >> >> (struct db-chunk (scratchdir-path chunkdir-path) #:mutable) >> >> (let ([old-mut set-db-chunk-scratchdir-path!]) >> (set! set-db-chunk-scratchdir-path! >> (lambda (chnk val) >> (old-mut chnk (if (path? val) (path->string val) val)))))) >> >> Alternatively, I could define my struct and then make a bunch of >> custom manipulation functions, but then (a) I've got these unguarded >> functions floating around and (b) I've given up a major advantage of >> structs, which is their concision. >> >> >> Consider the introduction of a syntax transformer that refines struct >> according to your needs. The sketch below is a bit brittle but if you >> need to strengthen it, I am sure our virtual macrologists can help. >> >> — Matthias >> >> >> >> >> #lang racket >> >> ;; --------------------------------------------------------------- >> ;; in some module/file: >> >> #; >> (provide >> ;; SYNTAX (struct/ccc Id [Id ...] MINUS Id ...) >> ;; SEMANTICS (struct/ccc a [b ...] MINUS c ...) is like >> ;; (struct a [b ...]) but hides the struct-defined functions >> ;; c ... >> struct/ccc) >> >> (define-syntax (struct/ccc stx) >> (syntax-case stx (MINUS PLUS) >> [(struct/ccc s [a ...] (MINUS x ...) (PLUS [f ex] ...)) >> ;; ==> >> (let ((my-require (datum->syntax stx '(require 'server)))) >> #`(begin >> (module server #,(datum->syntax stx 'racket) >> (provide >> (except-out (struct-out s) x ...)) >> (struct s [a ...]) >> (set! f ex) ...) >> #,my-require))])) >> >> ;; --------------------------------------------------------------- >> ;; require the module here >> >> (struct/ccc s [a b c] >> (MINUS s-a) >> (PLUS [s-b (let ((old s-b)) (λ (x) (define b (old x)) (* 2 >> b)))])) >> (define s0 (s 1 2 3)) >> (s-b s0) > > -- > You received this message because you are subscribed to the Google Groups > "Racket Users" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to racket-users+unsubscr...@googlegroups.com. > For more options, visit https://groups.google.com/d/optout. -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
