www

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

multiassoc-syntax.rkt (1328B)

      1 #lang typed/racket
      2 (require "typed-untyped.rkt")
      3 (define-typed/untyped-modules #:no-test
      4   (provide multiassoc-syntax
      5            cdr-assoc-syntax
      6            assoc-syntax)
      7   
      8   (require "typed-untyped.rkt")
      9   (if-typed (require phc-toolkit/aliases)
     10             (require phc-toolkit/untyped/aliases))
     11   (require-typed/untyped "stx.rkt")
     12   
     13   ;; TODO: cdr-stx-assoc is already defined in lib/low.rkt
     14   
     15   (define-type (Stx-AList A)
     16     (Syntaxof (Listof (Syntaxof (Pairof Identifier A)))))
     17   
     18   (: multiassoc-syntax (∀ (A) (→ Identifier (Stx-AList A) (Listof A))))
     19   (define (multiassoc-syntax query alist)
     20     ((inst map A (Syntaxof (Pairof Identifier A)))
     21      stx-cdr
     22      (filter (λ ([xy : (Syntaxof (Pairof Identifier A))])
     23                (free-identifier=? query (stx-car xy)))
     24              (syntax->list alist))))
     25   
     26   (: cdr-assoc-syntax (∀ (A) (→ Identifier (Stx-AList A) A)))
     27   (define (cdr-assoc-syntax query alist)
     28     (stx-cdr (assert (assoc-syntax query alist))))
     29   
     30   (: assoc-syntax (∀ (A) (→ Identifier
     31                             (Stx-AList A)
     32                             (U False (Syntaxof (Pairof Identifier A))))))
     33   (define (assoc-syntax query alist)
     34     (findf (λ ([xy : (Syntaxof (Pairof Identifier A))])
     35              (free-identifier=? query (stx-car xy)))
     36            (syntax->list alist))))