www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

expander-types.rkt (899B)

      1 #lang racket
      2 
      3 (require fancy-app
      4          predicates
      5          point-free)
      6 
      7 (provide
      8  (contract-out
      9   [expander-type? predicate/c]
     10   [make-expander-type (-> expander-type?)]
     11   [make-union-expander-type (->* (expander-type?) () #:rest (listof expander-type?) expander-type?)]
     12   [expander-type-includes? (-> expander-type? expander-type? boolean?)]))
     13 
     14 (define (type-includes? symtree-type1 symtree-type2)
     15   (define flat-type1 (flatten symtree-type1))
     16   (define flat-type2 (flatten symtree-type2))
     17   (true? (ormap (member _ flat-type1) flat-type2)))
     18 
     19 (struct expander-type (symtree-type) #:prefab)
     20 
     21 (define (make-expander-type)
     22   (expander-type (gensym)))
     23 
     24 (define (make-union-expander-type . expander-types)
     25   (define symtree-types (map expander-type-symtree-type expander-types))
     26   (expander-type symtree-types))
     27 
     28 (define/wind-pre* expander-type-includes?
     29   type-includes? expander-type-symtree-type)