2019-05-24 19:08:08 +00:00
|
|
|
#lang turnstile
|
|
|
|
|
|
|
|
(provide Left
|
|
|
|
Right
|
|
|
|
Either
|
|
|
|
left
|
|
|
|
right
|
2020-09-24 15:05:55 +00:00
|
|
|
partition/either)
|
2019-05-24 19:08:08 +00:00
|
|
|
|
|
|
|
(require "core-types.rkt")
|
|
|
|
(require "core-expressions.rkt")
|
|
|
|
(require "for-loops.rkt")
|
|
|
|
(require "list.rkt")
|
|
|
|
|
|
|
|
(define-constructor* (left : Left v))
|
|
|
|
(define-constructor* (right : Right v))
|
|
|
|
|
|
|
|
(define-type-alias (Either A B)
|
|
|
|
(U (Left A)
|
|
|
|
(Right B)))
|
|
|
|
|
2020-07-21 20:01:06 +00:00
|
|
|
(define (∀ (X) (f [x : X] -> X))
|
|
|
|
x)
|
|
|
|
|
|
|
|
|
2020-09-24 15:05:55 +00:00
|
|
|
(define (∀ (X Y Z) (partition/either [xs : (List X)]
|
2020-07-21 20:01:06 +00:00
|
|
|
[pred : (→fn X (U (Left Y)
|
|
|
|
(Right Z)) #;(Either Y Z))]
|
2019-05-24 19:08:08 +00:00
|
|
|
-> (Tuple (List Y) (List Z))))
|
|
|
|
(for/fold ([acc (Tuple (List Y) (List Z)) (tuple (list) (list))])
|
|
|
|
([x xs])
|
|
|
|
(define y-or-z (pred x))
|
|
|
|
(match y-or-z
|
|
|
|
[(left (bind y Y))
|
|
|
|
(tuple (cons y (select 0 acc))
|
|
|
|
(select 1 acc))]
|
|
|
|
[(right (bind z Z))
|
|
|
|
(tuple (select 0 acc)
|
|
|
|
(cons z (select 1 acc)))])))
|