www

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

misc.rkt (2428B)

      1 #lang typed/racket
      2 (require "typed-untyped.rkt")
      3 (define-typed/untyped-modules #:no-test
      4   (provide hash-set**
      5            ;string-set!
      6            ;string-copy!
      7            ;string-fill!
      8            with-output-file
      9            or?)
     10   
     11   (require (for-syntax syntax/parse syntax/parse/experimental/template))
     12   
     13   ;; hash-set**: hash-set a list of K V pairs.
     14   (begin
     15     (: hash-set** (∀ (K V)
     16                      (→ (HashTable K V) (Listof (Pairof K V)) (HashTable K V))))
     17     (define (hash-set** h l)
     18       (if (null? l)
     19           h
     20           (hash-set** (hash-set h (caar l) (cdar l)) (cdr l)))))
     21   
     22   ;; Disable string mutation
     23   (begin
     24     (define-syntax (string-set! stx)
     25       (raise-syntax-error 'string-set! "Do not mutate strings." stx))
     26     (define-syntax (string-copy! stx)
     27       (raise-syntax-error 'string-copy! "Do not mutate strings." stx))
     28     (define-syntax (string-fill! stx)
     29       (raise-syntax-error 'string-fill! "Do not mutate strings." stx)))
     30   
     31   ;; with-output-file
     32   (begin
     33     #|
     34     (define-syntax (with-output-file stx)
     35       (syntax-parse stx
     36         [(_ filename:expr (~optional (~seq #:mode mode:expr))
     37             (~optional (~seq #:exists exists:expr))
     38             body ...)
     39          (template (with-output-to-file filename
     40                      (λ () body ...)
     41                      (?? (?@ #:mode mode))
     42                      (?? (?@ #:exists exists))))]))
     43     |#
     44     
     45     (define-syntax (with-output-file stx)
     46       (syntax-parse stx
     47         [(_ [var:id filename:expr]
     48             (~optional (~seq #:mode mode:expr))
     49             (~optional (~seq #:exists exists:expr))
     50             body ...)
     51          (template (call-with-output-file filename
     52                      (λ (var) body ...)
     53                      (?? (?@ #:mode mode))
     54                      (?? (?@ #:exists exists))))])))
     55   
     56   #;(: or? (∀ (A B) (case→ (→ (→ A A))
     57                            (→ (→ A B) (→ A B) * (→ A B)))))
     58   #;(define or?
     59       (case-lambda
     60         [() (λ (a)
     61               a)]
     62         [(f . f*) (λ (a)
     63                     (let ([b (f a)])
     64                       (if (or b (null? f*))
     65                           b
     66                           ((apply or? f*) a))))]))
     67   
     68   (: or? (∀ (A) (→ (→ A Boolean) * (→ A (U A #f)))))
     69   (define (or? . f*)
     70     (if (null? f*)
     71         (λ (a) a)
     72         (λ (a)
     73           (if ((car f*) a)
     74               a
     75               ((apply (inst or? A) (cdr f*)) a))))))