Subtyping relationship between struct types in typed/racket

Question

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.

Answer 1

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)))

Answer 2

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, ie the following does not work:

(if (zero? (send foo get-x))
  (ann (send foo get-x) Zero))