Reputation: 3244
If in typed/racket I define three struct
s:
(struct: foo ([a : Number]))
(struct: bar ([b : String]))
(struct: st ([a : Number] [b : String] [c : Number]))
How can I make st
be both a subtype of foo
and of bar
, so that both of the following work?
((λ: ([x : bar]) x) (st 1 "b" 3))
((λ: ([x : foo]) x) (st 1 "b" 3))
I'm interested in any solution or hack that can provide a similar feature, be it multiple inheritance, re-implementing struct
through functions or something else. I'm already defining my struct
s through a macro, so if I have to generate a bit of boilerplate, it doesn't matter.
Upvotes: 0
Views: 219
Reputation: 3244
Mathematically, a (purely functional, immutable) struct
is a function which maps field names to values. Since in typed/racket
a function type that maps a small set of inputs is a subset of a function type that maps a larger set of inputs, we can emulate structs via functions and a macro for a bit of syntactic sugar.
Note that if you use a more recent version of typed/racket, you may have to adjust the type syntax a bit, namely moving the arrows →
to the beginning of their enclosing parenthesis, and perhaps a few other small adjustments.
; If it quacks…
(require (for-syntax racket/syntax))
(require (for-syntax syntax/parse))
(define-syntax (duck stx)
(syntax-parse stx
[(_ name:id ((field:id (~datum :) type) ...))
(define/with-syntax make-name (format-id #'name "make-~a" #'name))
(define/with-syntax (name-field ...) (map (λ (f) (format-id #'name "~a-~a" #'name f)) (syntax-e #'(field ...))))
#'(begin
(define-type name
(case→
['field → type] ...)
#:omit-define-syntaxes)
(: make-name (type ... → name))
(define (make-name field ...)
(λ (field-selector)
(cond
[(eq? field-selector 'field) field] ...)))
; Remove this line and use (make-mystruct 1 "b" 3)
; instead of the shorthand (mystruct 1 "b" 3)
; if #:omit-define-syntaxes stops working.
(define name make-name)
(begin
(: name-field (name -> type))
(define (name-field x)
(x 'field)))
...
)]))
Usage:
(duck dfoo ([a : Number]))
(duck dbar ([b : String]))
(duck dbaz ([c : String]))
(duck dquux ([a : Number] [d : Number]))
(duck dfloz ([a : Number] [c : Number]))
(duck dst ([a : Number] [b : String] [c : Number]))
(define upcast-foo ((λ: ([x : dfoo]) x) (dst 1 "b" 3)))
(define upcast-bar ((λ: ([x : dbar]) x) (dst 1 "b" 3)))
; This one fails because dbaz has c : String instead of c : Number
; (define result-baz ((λ: ([x : dbaz]) x) (dst 1 "b" 3)))
; This one is not even close (wrong field name)
; (define result-quux ((λ: ([x : dquux]) x) (dst 1 "b" 3)))
(define upcast-floz ((λ: ([x : dfloz]) x) (dst 1 "b" 3)))
(dfoo-a upcast-foo) ; 1
(dbar-b upcast-bar) ; "b"
(dfloz-a upcast-floz) ; 1
(dfloz-c upcast-floz) ; 3
; Fails with error: "Type Checker: Expected dfoo, but got dbar in: upcast-bar"
; (dfoo-a upcast-bar)
The duck
macro generates this code for dst
:
(define-type dst
(case->
['a -> Number]
['b -> String]
['c -> Number])
#:omit-define-syntaxes)
(: make-dst (Number String Number -> dst))
(define (make-dst a b c)
(λ (field-name)
(cond
[(eq? field-name 'a) a]
[(eq? field-name 'b) b]
[(eq? field-name 'c) c])))
(define dst make-dst)
(begin
(: dst-a (dst -> Number))
(define (dst-a x)
(x 'a)))
(begin
(: dst-b (dst -> String))
(define (dst-b x)
(x 'b)))
(begin
(: dst-c (dst -> Number))
(define (dst-c x)
(x 'c)))
Upvotes: 1
Reputation: 3244
This feature is already implemented for classes in typed/racket
(in v6.2.0.2, and probably in v6.1.1 too):
#lang typed/racket
(require (for-syntax syntax/parse))
(require (for-syntax racket/syntax))
(define-syntax (duck stx)
(syntax-parse stx
[(_ (field type) ...)
(define/with-syntax (the-field ...) (map (λ (f) (format-id f "the-~a" f)) (syntax-e #'(field ...))))
(define/with-syntax (get-field ...) (map (λ (f) (format-id f "get-~a" f)) (syntax-e #'(field ...))))
#'(class object%
(super-new)
(init [field : type] ...)
(define the-field : type
field) ...
(define/public (get-field) : type
the-field) ...
)]))
Usage:
(: foo (Object (get-x (→ Real)) (get-y (→ String))))
(define foo (new (duck (x Real)
(z Number)
(y String))
[x 42]
[z 123]
[y "y"]))
(send foo get-x)
(send foo get-y)
; (send foo get-z) ;; Does not typecheck, as expected.
However, it has the drawback that one can't declare immutable classes, and therefore type occurrence doesn't work on class fields, i.e. the following does not work:
(if (zero? (send foo get-x))
(ann (send foo get-x) Zero))
Upvotes: 0