www

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

type-inference-helpers.rkt (1587B)


      1 #lang typed/racket
      2 (require "typed-untyped.rkt")
      3 (define-typed/untyped-modules #:no-test
      4   (provide cars cdrs lists maybe-vector->list)
      5   
      6   #|
      7   ;; This does not work, in the end.
      8   (provide imap)
      9   (define-syntax (imap stx)
     10     (syntax-parse stx
     11       [(_ lst:expr var:id (~optional (~literal →)) . body)
     12        #'(let ()
     13            (define #:∀ (T) (inlined-map [l : (Listof T)])
     14              (if (null? l)
     15                  '()
     16                  (cons (let ([var (car l)]) . body)
     17                        (inlined-map (cdr l)))))
     18            (inlined-map lst))]))
     19   |#
     20   
     21   (: cars (∀ (A) (→ (Listof (Pairof A Any)) (Listof A))))
     22   (define (cars l) ((inst map A (Pairof A Any)) car l))
     23   
     24   (: cdrs (∀ (B) (→ (Listof (Pairof Any B)) (Listof B))))
     25   (define (cdrs l) ((inst map B (Pairof Any B)) cdr l))
     26 
     27   (: lists (∀ (A) (→ (Listof A) (Listof (List A)))))
     28   (define (lists l) ((inst map (List A) A) (λ (x) (list x)) l))
     29 
     30   (module m-maybe-vector->list racket/base
     31     (provide maybe-vector->list)
     32     (define (maybe-vector->list v)
     33       (if (vector? v)
     34           (vector->list v)
     35           #f)))
     36 
     37   (require (only-in typed/racket/unsafe unsafe-require/typed)
     38            "typed-untyped.rkt")
     39   (if-typed
     40    (unsafe-require/typed 'm-maybe-vector->list
     41                          [maybe-vector->list (→ Any (U (Listof Any) #f))])
     42    (require 'm-maybe-vector->list))
     43 
     44   (when-typed
     45    (require type-expander)
     46    (provide maybe-apply-type)
     47    (define-type-expander (maybe-apply-type stx)
     48      (syntax-case stx ()
     49        [(_ τ) #'τ]
     50        [(_ τ . args) #'(τ . args)]))))