-- Adapted from QuickChick source code -- https://github.com/QuickChick/QuickChick/blob/master/src/LazyList.v /-- Lazy Lists are implemented by thunking the computation for the tail of a cons-cell. -/ inductive LazyList (α : Type u) where | lnil | lcons : α → Thunk (LazyList α) → LazyList α deriving Inhabited namespace LazyList /-- Membership in a `LazyList`. -/ inductive InLazyList {α : Type u} (a : α) : LazyList α -> Prop where | InLHead l : InLazyList a (lcons a l) | InLNext b l : a ≠ b -> InLazyList a l.get -> InLazyList a (lcons b l) /-- Convenience definition for inverted membership. -/ abbrev InLazyList' {α} l (a : α) := InLazyList a l instance {α} : Membership α (LazyList α) := Membership.mk InLazyList' /-- Tail-recursive helper for converting `LazyList` to `List`, where `acc` is the list accumulated so far - The accumulation prevents stack overflow when converting large `LazyList`s to regular lists -/ def toListAux (acc : List α) : LazyList α → List α | .lnil => acc.reverse | .lcons x xs => toListAux (x :: acc) xs.get /-- Converts a `LazyList` to an ordinary list by forcing all the embedded thunks -/ def toList (l : LazyList α) : List α := toListAux [] l /-- Converts a `List` into a `LazyList`-/ def fromList (l : List α) : LazyList α := l.foldr (fun a acc => .lcons a ⟨fun _ => acc⟩) .lnil /-- We pretty-print `LazyList`s by converting them to ordinary lists (forcing all the thunks) & pretty-printing the resultant list. -/ instance [Repr α] : Repr (LazyList α) where reprPrec l _ := repr l.toList /-- Retrieves a prefix of the `LazyList` (only the thunks in the prefix are evaluated) -/ def take (n : Nat) (l : LazyList α) : List α := go n l [] where go n l acc := match n with | .zero => acc | .succ n' => match l with | .lnil => acc | .lcons x xs => go n' xs.get (x :: acc) /-- Get the first element of the list, if there is one. otherwise return `.none`. -/ def head? (l : LazyList α) : Option α := match l with | lnil => none | lcons x _ => some x /-- Appends two `LazyLists` together -/ def append (xs : LazyList α) (ys : LazyList α) : LazyList α := match xs with | lnil => ys | lcons x xs => lcons x ⟨fun _ => append xs.get ys⟩ /-- `observe tag i` uses `dbg_trace` to emit a trace of the variable associated with `tag` -/ def observe (tag : String) (i : Fin n) : Nat := dbg_trace "{tag}: {i.val}" i.val /-- Maps a function over a LazyList -/ def mapLazyList (f : α → β) (l : LazyList α) : LazyList β := match l with | .lnil => .lnil | .lcons x xs => .lcons (f x) ⟨fun _ => mapLazyList f xs.get⟩ /-- Length of a LazyList. Warning: this forces the whole list. -/ def length (l : LazyList α) : Nat := let rec aux l n := match l with | .lnil => n | .lcons _ xs => aux xs.get (1 + n) aux l 0 /-- `Functor` instance for `LazyList` -/ instance : Functor LazyList where map := mapLazyList /-- Return the lazylist that contains the elements `x` of `l` such that `p x = .true`. -/ def filter {α} (p : α -> Bool) (l : LazyList α) : LazyList α := match l with | lnil => lnil | lcons a as => if p a then lcons a ⟨fun _ => filter p as.get⟩ else filter p as.get /-- Creates a singleton LazyList -/ def pureLazyList (x : α) : LazyList α := LazyList.lcons x $ Thunk.mk (fun _ => .lnil) /-- Alias for `pureLazyList` -/ def singleton (x : α) : LazyList α := pureLazyList x /-- Stack-safe flatten using continuation-passing style -/ def concatCPS (l : LazyList (LazyList α)) : LazyList α := go l id where go (current : LazyList (LazyList α)) (cont : LazyList α → LazyList α) : LazyList α := match current with | .lnil => cont .lnil | .lcons x l' => appendToResult x (go l'.get cont) appendToResult (xs : LazyList α) (ys : LazyList α) : LazyList α := match xs with | .lnil => ys | .lcons x xs' => .lcons x (Thunk.mk fun _ => appendToResult xs'.get ys) /-- Flattens a `LazyList (LazyList α)` into a `LazyList α` -/ def concat (l : LazyList (LazyList α)) : LazyList α := match l with | lnil => lnil | lcons lnil l' => concat l'.get | lcons (lcons a as) l' => lcons a ⟨ fun _ => (concat (lcons as.get l'))⟩ /-- Round-robin concatenation of lazy enumerations: lazily takes one element from the back of each lazy enumeration in turn until there are no more to go, then starts at the head of the enumeration of enumerations. -/ partial def roundRobinConcat (l : LazyList (LazyList α)) : LazyList α := let rec go (current : LazyList (LazyList α)) (queue : List (LazyList α)) : LazyList α := match current with | lnil => match queue with | [] => lnil | q :: qs => go (lcons q ⟨fun _ => lnil⟩) qs | lcons lnil rest => go rest.get queue | lcons (lcons a as) rest => lcons a ⟨fun _ => go rest.get (queue ++ [as.get])⟩ go l [] /-- Bind for `LazyList`s is just `concatMap` (same as the list monad) -/ partial def bindLazyList (l : LazyList α) (f : α → LazyList β) : LazyList β := roundRobinConcat (f <$> l) /-- `Monad` instance for `LazyList` -/ instance : Monad LazyList where pure := pureLazyList bind := bindLazyList /-- `Applicative` instance for `LazyList` -/ instance : Applicative LazyList where pure := pureLazyList /-- `Alternative` instance for `LazyList`s, where `xs <|> ys` is just `LazyList` append -/ instance : Alternative LazyList where failure := .lnil orElse xs f := append xs (f ()) /-- Creates a lazy list by repeatedly applying a function `s` to generate a sequence of elements -/ def lazySeq (s : α → α) (lo : α) (len : Nat) : LazyList α := let rec go (current : α) (numRemainingElements : Nat) : LazyList α := match numRemainingElements with | .zero => .lnil | .succ remaining' => .lcons current (Thunk.mk $ fun _ => go (s current) remaining') go lo len /-- Creates a lazy sequence from 0 to n built lazily. -/ def range (n : Nat) : LazyList Nat := lazySeq .succ .zero n /-- ForIn instance for LazyList -/ instance [Monad m] : ForIn m (LazyList α) α where forIn l init f := go l init f where go {β} (l : LazyList α) (acc : β) (f : α → β → m (ForInStep β)) : m β := do match l with | .lnil => return acc | .lcons a l' => do match ← (f a acc) with | ForInStep.done b' => return b' | .yield b' => go l'.get b' f -- Test that take 3 only evaluates first 3 elements /--info: First 3: [item2, item1, item0]-/ #guard_msgs in #eval do let result : LazyList String := .lcons "item0" ⟨fun _ => .lcons "item1" ⟨fun _ => .lcons "item2" ⟨fun _ => .lcons "item3" ⟨fun _ => .lcons (dbg_trace "5th element evaluated!"; "item4") ⟨fun _ => .lnil⟩⟩⟩⟩⟩ IO.println s!"First 3: {result.take 3}" pure () end LazyList