Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
#lang typed/racket/base
(require racket/match)
;; Input stream of datum D
(define-type (Stream D) (U (Datum D) 'Nothing 'EOS))
(struct: (D) Datum
([iota : D]) #:transparent)
;; Iteratee
(define-type (Iteratee D A) (U (Done D A) (Continue D A)))
(struct: (D A) Done ([stream : (Stream D)]
[accum : A]))
(struct: (D A) Continue
([step : ((Stream D) -> (U (Done D A) (Continue D A)))])) ;; ... -> (Iteratee D A)
(: complete (All (D A) (Iteratee D A) -> A))
(define (complete iter)
(match iter
[(Done _ accum) accum]
[(Continue step) (complete (step 'EOS))]))
(: iterate (All (D A) (Listof D) (Iteratee D A) -> (Iteratee D A)))
(define (iterate lst iter)
(match (cons lst iter)
[(cons '() i) i]
[(cons _ (Done _ _)) iter]
[(cons (list-rest x xs) (Continue k)) (iterate xs (k (Datum x)))]))
(: drop (All (D) Integer -> (Iteratee D Void)))
(define (drop n)
(: step (-> ((Stream D) -> (Iteratee D Void))))
(define (step)
(λ: ((str : (Stream D)))
(match str
[(Datum _) (drop (sub1 n))]
['Nothing (Continue (step))]
['EOS (Done 'EOS (void))])))
(if (zero? n)
(Done 'Nothing (void))
(Continue (step))))
(: head (All (D) (-> (Iteratee D (Option D)))))
(define (head)
(: step (-> ((Stream D) -> (Iteratee D (Option D)))))
(define (step)
(λ: ((str : (Stream D)))
(match str
[(Datum d) (Done 'EOS d)]
['Nothing (Continue (step))]
['EOS (Done 'EOS #f)])))
(Continue (step)))
(: seq (All (D A B) ((Iteratee D A) (A -> (Iteratee D B)) -> (Iteratee D B))))
(define (seq iter fn)
(match iter
[(Done d x) (match (fn x)
[(Done _ y) (Done d y)]
[(Continue step) (step d)])]
[(Continue step) (Continue (λ: ((d : (Stream D)))
(seq (step d) fn)))]))
(: drop1keep1Int (-> (Iteratee Integer (Option Integer))))
(define (drop1keep1Int)
((inst seq Integer Void (Option Integer)) ((inst drop Integer) 1) (λ: ((accum : Void)) ((inst head Integer)))))
;; Works GREAT
(complete (iterate '(1 2 3) (drop1keep1Int)))
;; Type Checking fails
;;(: drop1keep1Poly (All (D A B) (-> (Iteratee D B))))
;;(define (drop1keep1Poly)
;; (seq (drop 1) (λ: ((accum : A)) (head))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment