public
Created

  • Download Gist
iteratee.rkt
Racket
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
#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))))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.