signature SEQUENCE = sig

  type 'a seq = int -> 'a

  val constantly : 'a -> 'a seq               (* constant sequence *)
  val alternately : 'a * 'a -> 'a seq         (* alternating values *)
  val insert : 'a * 'a seq -> 'a seq

  val map : ('a -> 'b) -> 'a seq -> 'b seq
  val filter : ('a -> bool) -> 'a seq -> 'a seq

  val zip : 'a seq * 'b seq -> ('a * 'b) seq
  val unzip : ('a * 'b) seq -> 'a seq * 'b seq
  val merge : 'a seq * 'a seq -> 'a seq

  val stretch : int -> 'a seq -> 'a seq
  val shrink : int -> 'a seq -> 'a seq

  val take : int -> 'a seq -> 'a list
  val drop : int -> 'a seq -> 'a seq
  val shift : 'a seq -> 'a seq

  val loopback : ('a seq -> 'a seq) -> 'a seq

end

structure Sequence :> SEQUENCE = struct

    type 'a seq = int -> 'a

    fun constantly c n = c
    fun alternately (c,d) n = if n mod 2 = 0 then c else d
    fun insert (x, s) 0 = x
      | insert (x, s) n = s (n-1)

    fun map f s = f o s
    fun filter p s n =
	let
	    val x = s n
	in
	    if p x then x else filter p s (n+1)
	end

    fun zip (s1, s2) n = (s1 n, s2 n)
    fun unzip (s : ('a * 'b) seq) = (map #1 s, map #2 s)
    fun merge (s1, s2) n =
	(if n mod 2 = 0 then s1 else s2) (n div 2)

    fun stretch k s n = s (n div k)
    fun shrink k s n = s (n * k)

    fun drop k s n = s (n+k)
    fun shift s = drop 1 s
    fun take 0 _ = nil
      | take n s = s 0 :: take (n-1) (shift s)

    fun loopback loop n = loop (loopback loop) n

end

open Sequence

val evens : int seq = fn n => 2*n
val odds : int seq = fn n => 2*n+1
val nats : int seq = merge (evens, odds)
fun fibs n =
    (insert (1, insert (1, map (op +) (zip (drop 1 fibs, fibs)))))(n)

fun fibs_loop s = insert (1, insert (1, map (op +) (zip (drop 1 s, s))))
val fibs = loopback fibs_loop

fun bad_loop s n = s n + 1
val bad = loopback bad_loop
(* val _ = bad 0 *)

(* wires *)

datatype level = High | Low | Undef
type wire = level seq
type pair = (level * level) seq

val Z : wire = constantly Low
val O : wire = constantly High

(* clock pulse with given duration of each pulse *)
fun clock (freq:int):wire = stretch freq (alternately (Low, High))

(* combinational logic *)

infixr **
fun (f ** g) (x, y) = (f x, g y)

fun logical_and (Low, _) = Low
  | logical_and (_, Low) = Low
  | logical_and (High, High) = High
  | logical_and _ = Undef

fun logical_not Undef = Undef
  | logical_not High = Low
  | logical_not Low = High

fun logical_nop l = l

val logical_nor = logical_and o (logical_not ** logical_not)

type unary_gate = wire -> wire
type binary_gate = pair -> wire

fun gate f w 0 = Undef
  | gate f w i = f (w (i-1))

val delay : unary_gate = gate logical_nop
val inverter : unary_gate = gate logical_not
val nor_gate : binary_gate = gate logical_nor

(* Flip-flops *)

fun RS_ff (S : wire, R : wire) =
    let
	fun X n = nor_gate (zip (S, Y)) n
	and Y n = nor_gate (zip (X, R)) n
    in
	Y
    end

fun pulse b 0 w i = w i
  | pulse b n w 0 = b
  | pulse b n w i = pulse b (n-1) w (i-1)

val S = pulse Low 2 (pulse High 2 Z)
val R = pulse Low 6 (pulse High 2 Z)
val Q = RS_ff (S, R)
val _ = take 20 Q
val X = RS_ff (S, S)			(* unstable! *)
val _ = take 20 X

fun loopback2 (f : wire * wire -> wire * wire) =
    unzip (loopback (zip o f o unzip))

fun RS_ff' (S : wire, R : wire) =
    let
	fun RS_loop (X, Y) =
	    (nor_gate (zip (S, Y)), nor_gate (zip (X, R)))
    in
	loopback2 RS_loop
    end