)abbrev category LZSTAGG LazyStreamAggregate
++ Category of streams with lazy evaluation
++ Author: Clifton J. Williamson
++ Date Created: 22 November 1989
++ Keywords: stream, infinite list, infinite sequence
++ Description:
++ LazyStreamAggregate is the category of streams with lazy
++ evaluation.  It is understood that the function 'empty?' will
++ cause lazy evaluation if necessary to determine if there are
++ entries.  Functions which call 'empty?', e.g. 'first' and 'rest',
++ will also cause lazy evaluation if necessary.
++ Elements of LazyStreamAggregate are computed only when strictly
++ needed.  Lazy computation means that potential errors are
++ delayed, so errors are detected later than in case of normal
++ (eager) evaluation used by other aggregates.  In some cases
++ computation that would signal error when using eager evaluation
++ can succeed when using lazy evaluation.

LazyStreamAggregate(S : Type) : Category == StreamAggregate(S) with
  remove : (S -> Boolean, %) -> %
    ++ remove(f, st) returns a stream consisting of those elements of stream
    ++ st which do not satisfy the predicate f.
    ++ Note: \spad{remove(f, st) = [x for x in st | not f(x)]}.
  select : (S -> Boolean, %) -> %
    ++ select(f, st) returns a stream consisting of those elements of stream
    ++ st satisfying the predicate f.
    ++ Note: \spad{select(f, st) = [x for x in st | f(x)]}.
  explicitEntries? : % -> Boolean
    ++ explicitEntries?(s) returns true if the stream s has
    ++ explicitly computed entries, and false otherwise.
  explicitlyEmpty? : % -> Boolean
    ++ explicitlyEmpty?(s) returns true if the stream is an
    ++ (explicitly) empty stream.
    ++ Note: this is a null test which will not cause lazy evaluation.
  lazy? : % -> Boolean
    ++ lazy?(s) returns true if the first node of the stream s
    ++ is a lazy evaluation mechanism which could produce an
    ++ additional entry to s.
  lazyEvaluate : % -> %
    ++ lazyEvaluate(s) causes one lazy evaluation of stream s.
    ++ Caution: the first node must be a lazy evaluation mechanism
    ++ (satisfies \spad{lazy?(s) = true}) as there is no error check.
    ++ Note: a call to this function may
    ++ or may not produce an explicit first entry
  frst : % -> S
    ++ frst(s) returns the first element of stream s.
    ++ Caution: this function should only be called after a \spad{empty?} test
    ++ has been made since there is no error check.
  rst : % -> %
    ++ rst(s) returns a pointer to the next node of stream s.
    ++ Caution: this function should only be called after a \spad{empty?} test
    ++ has been made since there is no error check.
  numberOfComputedEntries : % -> NonNegativeInteger
    ++ numberOfComputedEntries(st) returns the number of explicitly
    ++ computed entries of stream st which exist immediately prior to the time
    ++ this function is called.
  extend : (%, Integer) -> %
    ++ extend(st, n) causes entries to be computed, if necessary,
    ++ so that 'st' will have at least 'n' explicit entries or so
    ++ that all entries of 'st' will be computed if 'st' is finite
    ++ with length <= n.
  complete : % -> %
    ++ complete(st) causes all entries of 'st' to be computed.
    ++ this function should only be called on streams which are
    ++ known to be finite.

 add

  MIN ==> 1  -- minimal stream index

  I   ==> Integer
  NNI ==> NonNegativeInteger
  L   ==> List
  U   ==> UniversalSegment Integer

  PINF ==> " potentially infinite stream, maybe use 'complete'"
  INFC ==> " infinite (cyclic) stream"

  import from List(S)

  indexx?            : (Integer, %) -> Boolean
  cycleElt           : % -> Union(%,"failed")
  computeCycleLength : % -> NNI
  computeCycleEntry  : (%, %) -> %

--% SETCAT functions

  if S has SetCategory then

    x = y ==
      eq?(x, y) => true
      explicitlyFinite? x and explicitlyFinite? y =>
        entries x = entries y
      explicitEntries? x and explicitEntries? y =>
        frst x = frst y and EQ(rst x, rst y)$Lisp
      -- treat cyclic streams
      false

--% HOAGG functions

  less?(x, n) ==
    n = 0    => false
    empty? x => true
    less?(rst x, (n-1) :: NNI)

  more?(x, n) ==
    empty? x => false
    n = 0    => true
    more?(rst x, (n-1) :: NNI)

  size?(x, n) ==
    empty? x => n = 0
    n = 0 => false
    size?(rst x, (n-1) :: NNI)

  # x ==
    -- error if stream is not finite
    y := x
    for i in 0.. repeat
      explicitlyEmpty? y  => return i
      lazy? y => error "#:" PINF
      y := rst y
      if odd? i then x := rst x
      eq?(x,y) => error "#:" INFC

--% CLAGG functions

  any?(f, x) ==
    -- error message only when x is a stream with lazy
    -- evaluation and f(s) = false for all stream elements
    -- 's' which have been computed when the function is
    -- called
    y := x
    for i in 0.. repeat
      explicitlyEmpty? y  => return false
      lazy? y => error "any?:" PINF
      f frst y => return true
      y := rst y
      if odd? i then x := rst x
      eq?(x, y) => return false

  every?(f, x) ==
    -- error message only when x is a stream with lazy
    -- evaluation and f(s) = true for all stream elements
    -- 's' which have been computed when the function is
    -- called
    y := x
    for i in 0.. repeat
      explicitlyEmpty? y => return true
      lazy? y => error "every?:" PINF
      not f frst y => return false
      y := rst y
      if odd? i then x := rst x
      eq?(x, y) => return true

--  following ops count and member? are only exported if % has finiteAggregate

--  count(f: S -> Boolean, x: %) ==
--    -- error if stream is not finite
--    count : NNI := 0
--    y := x
--    for i in 0.. repeat
--      explicitlyEmpty? y  => return count
--      lazy? y => error "count: infinite stream"
--      if f frst y then count := count + 1
--      y := rst y
--      if odd? i then x := rst x
--      eq?(x,y) => error "count: infinite stream"


--  if S has SetCategory then

--      count(s: S, x: %) == count(#1 = s, x)
--        -- error if stream is not finite

--    member?(s, x) ==
--      -- error message only when x is a stream with lazy
--      -- evaluation and 's' is not among the stream elements
--      -- which have been computed when the function is called
--      y := x
--      for i in 0.. repeat
--        explicitlyEmpty? y  => return false
--        lazy? y => error "member?: infinite stream"
--        frst y = s => return true
--        y := rst y
--        if odd? i then x := rst x
--        eq?(x, y) => return false

  entries x ==
    -- returns a list of elements which have been computed
    -- error if infinite
    y := x
    l : L S := empty()
    for i in 0.. repeat
      explicitlyEmpty? y  => return reverse! l
      lazy? y => error "entries:" PINF
      l := concat(frst y, l)
      y := rst y
      if odd? i then x := rst x
      eq?(x,y) => error "entries:" INFC

--% CLAGG functions

  construct l ==
      empty? l => empty()
      l := reverse l
      res := empty()
      while not empty? l repeat
          res := concat(first l, res)
          l := rest l
      res

  --entries x ==
    -- returns a list of the stream elements
    -- error if the stream is not finite
    --members x

--% ELTAGG functions

  elt(x : %, n : I) ==
    n < MIN or empty? x => error "elt: no such element"
    n = MIN => frst x
    elt(rst x, n - 1)

  elt(x : %, n : I, s : S) ==
    n < MIN or empty? x => s
    n = MIN => frst x
    elt(rst x, n - 1)

--% IXAGG functions

-- following assumes % has finiteAggregate and S has SetCategory
--  entry?(s, x) ==
--    -- error message only when x is a stream with lazy
--    -- evaluation and 's' is not among the stream elements
--    -- which have been computed when the function is called
--    member?(s, x)

  --entries x ==
    -- error if the stream is not finite
    --members x

  indexx?(n, x) ==
    empty? x => false
    n = MIN => true
    indexx?(n-1, rst x)

  index?(n, x) ==
    -- returns 'true' iff 'n' is the index of an entry which
    -- may or may not have been computed when the function is
    -- called
    -- additional entries are computed if necessary
    n < MIN => false
    indexx?(n, x)

  indices x ==
    -- error if stream is not finite
    y := x
    l : L I := empty()
    for i in MIN.. repeat
      explicitlyEmpty? y  => return reverse! l
      lazy? y => error "indices:" PINF
      l := concat(i, l)
      y := rst y
      if odd? i then x := rst x
      eq?(x,y) => error "indices:" INFC

  maxIndex x ==
    -- error if stream is not finite
    empty? x =>
      error "maxIndex: no maximal index for empty stream"
    y := rst x
    for i in MIN.. repeat
      explicitlyEmpty? y  => return i
      lazy? y => error "maxIndex:" PINF
      y := rst y
      if odd? i then x := rst x
      eq?(x,y) => error "maxIndex:" INFC

  minIndex x ==
    empty? x => error "minIndex: no minimal index for empty stream"
    MIN

--% LNAGG functions

  delete(x : %, n : I) ==
  -- non-destructive
    not index?(n,x) => error "delete: index out of range"
    concat(first(x, (n - MIN) :: NNI), rest(x, (n - MIN + 1) :: NNI))

  delete(x : %, seg : U) ==
    low := low(seg)
    hasHi seg =>
      high := high(seg)
      high < low => copy x
      (not index?(low, x)) or (not index?(high, x)) =>
        error "delete: index out of range"
      concat(first(x, (low - MIN) :: NNI), rest(x, (high - MIN + 1) :: NNI))
    not index?(low,x) => error "delete: index out of range"
    first(x, (low - MIN) :: NNI)

  insert(s : S, x : %, n : I) ==
    not index?(n,x) => error "insert: index out of range"
    nn := (n - MIN) :: NNI
    concat([first(x, nn), concat(s, empty()), rest(x, nn)])

  insert(y : %, x : %, n : I) ==
    not index?(n,x) => error "insert: index out of range"
    nn := (n - MIN) :: NNI
    concat([first(x, nn), y, rest(x, nn)])

--% RCAGG functions

  cycleElt x == cycleElt(x)$CyclicStreamTools(S, %)

  cyclic? x ==
    cycleElt(x) case "failed" => false
    true

  if S has SetCategory then
    child?(x, y) ==
      empty? y => error "child: no children"
      x = rst y

  children x ==
    empty? x => error "children: argument is empty"
    empty? rst x => empty()
    [rst x]

  distance(x, z) ==
    y := x
    for i in 0.. repeat
      eq?(y, z) => return i
      (explicitlyEmpty? y) or (lazy? y) =>
        error "distance: 2nd arg not a descendent of the 1st"
      y := rst y
      if odd? i then x := rst x
      eq?(x, y) =>
        error "distance: 2nd arg not a descendent of the 1st"

  if S has SetCategory then
    node?(z, x) ==
      -- error message only when x is a stream with lazy
      -- evaluation and 'y' is not a node of 'x'
      -- which has been computed when the function is called
      y := x
      for i in 0.. repeat
        z = y => return true
        explicitlyEmpty? y => return false
        lazy? y => error "node?:" PINF
        y := rst y
        if odd? i then x := rst x
        eq?(x, y) => return false

  nodes x ==
    y := x
    l : L % := []
    for i in 0.. repeat
      explicitlyEmpty? y => return reverse! l
      lazy? y => error "nodes:" PINF
      l := concat(y, l)
      y := rst y
      if odd? i then x := rst x
      eq?(x,y) => error "nodes:" INFC
    l -- @#$%^& compiler

  leaves x ==
      y := x
      for i in 0.. repeat
          explicitlyEmpty? y => return []
          lazy? y => error "leaves:" PINF
          leaf? y => return [value y]
          y := rst y -- there is only one children
          if odd? i then x := rst x
          eq?(x, y) => error "leaves:" INFC

  value x == first x

--% URAGG functions

  computeCycleLength cycElt ==
    computeCycleLength(cycElt)$CyclicStreamTools(S, %)

  computeCycleEntry(x, cycElt) ==
    computeCycleEntry(x, cycElt)$CyclicStreamTools(S, %)

  cycleEntry x ==
    cycElt := cycleElt x
    cycElt case "failed" =>
      error "cycleEntry: non-cyclic stream"
    computeCycleEntry(x, cycElt@%)

  cycleLength x ==
    cycElt := cycleElt x
    cycElt case "failed" =>
      error "cycleLength: non-cyclic stream"
    computeCycleLength(cycElt@%)

  cycleTail x ==
    cycElt := cycleElt x
    cycElt case "failed" =>
      error "cycleTail: non-cyclic stream"
    y := x := computeCycleEntry(x, cycElt@%)
    z := rst x
    repeat
      eq?(x, z) => return y
      y := z ; z := rst z

  elt(x,"first") == first x

  first(x, n) ==
  -- former name: take
    n = 0 or empty? x => empty()
    concat(frst x, first(rst x, (n-1) :: NNI))

  rest x ==
    empty? x => error "Can't take the rest of an empty stream."
    rst x

  elt(x,"rest") == rest x

  rest(x, n) ==
  -- former name: drop
    n = 0 or empty? x => x
    rest(rst x, (n-1) :: NNI)

  last x ==
    -- error if stream is not finite
    empty? x => error "last: empty stream"
    y1 := x
    y2 := rst x
    for i in 0.. repeat
      explicitlyEmpty? y2 => return frst y1
      lazy? y2 => error "last:" PINF
      y1 := y2
      y2 := rst y2
      if odd? i then x := rst x
      eq?(x,y2) => error "last:" INFC

  if % has finiteAggregate then -- # is only defined for finiteAggregates
    last(x, n) ==
      possiblyInfinite? x => error "last:" PINF
      m := # x
      m < n => error "last: index out of range"
      copy rest(x, (m-n)::NNI)

  elt(x,"last") == last x

  tail x ==
    -- error if stream is not finite
    empty? x => error "tail: empty stream"
    y1 := x
    y2 := rst x
    for i in 0.. repeat
      explicitlyEmpty? y2 => return y1
      lazy? y2 => error "tail:" PINF
      y1 := y2
      y2 := rst y2
      if odd? i then x := rst x
      eq?(x,y2) => error "tail:" INFC

--% STAGG functions

  possiblyInfinite? x ==
    y := x
    for i in 0.. repeat
      explicitlyEmpty? y  => return false
      lazy? y => return true
      if odd? i then x := rst x
      y := rst y
      eq?(x, y) => return true

  explicitlyFinite? x == not possiblyInfinite? x

--% LZSTAGG functions

  extend(x, n) ==
    y := x
    for i in 1..n while not empty? y repeat y := rst y
    x

  complete x ==
    y := x
    while not empty? y repeat y := rst y
    x

)abbrev package CSTTOOLS CyclicStreamTools
++ Functions for dealing with cyclic streams
++ Author: Clifton J. Williamson
++ Date Created: 5 December 1989
++ Keywords: stream, cyclic
++ Description:
++ This package provides tools for working with cyclic streams.
CyclicStreamTools(S, ST) : Exports == Implementation where
  S  : Type
  ST : LazyStreamAggregate S

  Exports ==> with

    cycleElt : ST -> Union(ST,"failed")
      ++ cycleElt(s) returns a pointer to a node in the cycle if the stream s is
      ++ cyclic and returns "failed" if s is not cyclic
    computeCycleLength : ST -> NonNegativeInteger
      ++ computeCycleLength(s) returns the length of the cycle of a
      ++ cyclic stream t, where s is a pointer to a node in the
      ++ cyclic part of t.
    computeCycleEntry : (ST, ST) -> ST
      ++ computeCycleEntry(x, cycElt), where cycElt is a pointer to a
      ++ node in the cyclic part of the cyclic stream x, returns a
      ++ pointer to the first node in the cycle

  Implementation ==> add

    cycleElt x ==
      y := x
      for i in 0.. repeat
        (explicitlyEmpty? y) or (lazy? y) => return "failed"
        y := rst y
        if odd? i then x := rst x
        eq?(x, y) => return y

    computeCycleLength cycElt ==
      y := cycElt
      for i in 1.. repeat
        y := rst y
        eq?(y, cycElt) => return i

    computeCycleEntry(x, cycElt) ==
      y := rest(x, computeCycleLength cycElt)
      repeat
        eq?(x, y) => return x
        x := rst x ; y := rst y

)abbrev domain STREAM Stream
++ Implementation of streams via lazy evaluation
++ Authors: Burge, Watt; updated by Clifton J. Williamson
++ Date Created: July 1986
++ Keywords: stream, infinite list, infinite sequence
++ Examples:
++ References:
++ Description:
++ A stream is an implementation of a possibly infinite sequence using
++ a list of terms that have been computed and a function closure
++ to compute additional terms when needed.

Stream(S : Type) : Exports == Implementation where
--  problems:
--  1) dealing with functions which basically want a finite structure
--  2) 'map' doesn't deal with cycles very well

  B   ==> Boolean
  OUT ==> OutputForm
  I   ==> Integer
  L   ==> List
  NNI ==> NonNegativeInteger
  U   ==> UniversalSegment I

  Exports ==> Join(LazyStreamAggregate(S), shallowlyMutable) with

    coerce : L S -> %
      ++ coerce(l) converts a list l to a stream.
    repeating : L S -> %
      ++ repeating(l) is a repeating stream whose period is the list l.
    if S has SetCategory then
      repeating? : (L S, %) -> B
        ++ repeating?(l, s) returns true if a stream s is periodic
        ++ with period l, and false otherwise.
    findCycle : (NNI, %) -> Record(cycle? : B, prefix : NNI, period : NNI)
      ++ findCycle(n, st) determines if st is periodic within n.
    delay : (() -> %) -> %
      ++ delay(f) creates a stream with a lazy evaluation defined by function f.
      ++ Caution: This function can only be called in compiled code.
    cons : (S, %) -> %
      ++ cons(a, s) returns a stream whose \spad{first} is \spad{a}
      ++ and whose \spad{rest} is s.
      ++ Note: \spad{cons(a, s) = concat(a, s)}.
    if S has SetCategory then
      showElements : (NNI, %) -> OUT
        ++ showElements(n, st) computes and creates and output form of
        ++ the first n entries of st.
      showAllElements : % -> OUT
        ++ showAllElements(s) creates an output form which displays all
        ++ computed elements.
      showAll? : () -> B
        ++ showAll?() returns true if all computed entries of streams
        ++ will be displayed.
        --!! this should be a function of one argument
    setrest! : (%, I, %) -> %
      ++ setrest!(x, n, y) sets rest(x, n) to y. The function will expand
      ++ cycles if necessary.
    stream : (() -> S) -> %
      ++ stream(f) creates an infinite stream all of whose elements are
      ++ equal to \spad{f()}.
      ++ Note: \spad{stream(f) = [f(), f(), f(), ...]}.
    stream : (S -> S, S) -> %
      ++ stream(f, x) creates an infinite stream whose first element is
      ++ x and whose nth element (\spad{n > 1}) is f applied to the previous
      ++ element. Note: \spad{stream(f, x) = [x, f(x), f(f(x)), ...]}.
    filterWhile : (S -> Boolean, %) -> %
      ++ filterWhile(p, s) returns \spad{[x0, x1, ..., x(n-1)]} where
      ++ \spad{s = [x0, x1, x2, ..]} and
      ++ n is the smallest index such that \spad{p(xn) = false}.
    filterUntil : (S -> Boolean, %) -> %
      ++ filterUntil(p, s) returns \spad{[x0, x1, ..., x(n)]} where
      ++ \spad{s = [x0, x1, x2, ..]} and
      ++ n is the smallest index such that \spad{p(xn) = true}.
--    if S has SetCategory then
--      map: ((S, S) -> S, %, %, S) -> %
--       ++ map(f, x, y, a) is equivalent to map(f, x, y)
--       ++ If z = map(f, x, y, a), then z = map(f, x, y) except if
--       ++ x.n = a and rest(rest(x, n)) = rest(x, n) in which case
--       ++ rest(z, n) = rest(y, n) or if y.m = a and rest(rest(y, m)) =
--       ++ rest(y, m) in which case rest(z, n) = rest(x, n).
--       ++ Think of the case where f(xi, yi) = xi + yi and a = 0.

  Implementation ==> add
    MIN ==> 1  -- minimal stream index; see also the defaults in LZSTAGG
    x : %
    DOTS ==> "..."::Symbol::OUT
    import from CyclicStreamTools(S, %)

--% representation

    -- This description of the rep is not quite true.
    -- The Rep is a pair of one of three forms:
    --    [value: S,             rest: %]
    --    [nullstream:    Magic, NIL    ]
    --    [nonnullstream: Magic, fun: () -> %]
    --    [uninitializedstream : Magic, 0]
    -- Could use a record of unions if we could guarantee no tags.

    NullStream :    S := _$NullStream$Lisp    pretend S
    NonNullStream : S := _$NonNullStream$Lisp pretend S
    UninitializedStream : S := _$UninitializedStream$Lisp pretend S

    Rep := Record(firstElt : S, restOfStream : %)

    explicitlyEmpty? x == EQ(frst x, NullStream)$Lisp
    lazy? x            == EQ(frst x, NonNullStream)$Lisp
    uninitialized? : % -> Boolean
    uninitialized? x   == EQ(frst x, UninitializedStream)$Lisp

--% signatures of local functions

    setfrst!     : (%, S) -> S
    setrst!      : (%, %) -> %
    setToNil!    : % -> %
    setrestt!    : (%, I, %) -> %
    lazyEval      : % -> %
    expand!      : (%, I) -> %

--% functions to access or change record fields without lazy evaluation

    frst x == x.firstElt
    rst  x == x.restOfStream

    setfrst!(x, s) == x.firstElt := s
    setrst!(x, y)  == x.restOfStream := y

    setToNil! x ==
    -- destructively changes x to a null stream
      setfrst!(x, NullStream); setrst!(x, NIL$Lisp)
      x

--% SETCAT functions

    if S has SetCategory then

      getm              : (%, L OUT, I) -> L OUT
      streamCountCoerce : % -> OUT
      listm             : (%, L OUT, I) -> L OUT

      getm(x, le, n) ==
        explicitlyEmpty? x => le
        lazy? x =>
          n > 0 =>
            empty? x => le
            getm(rst x, concat(frst(x) :: OUT, le), n - 1)
          concat(DOTS,le)
        eq?(x, rst x) => concat(overbar(frst(x) :: OUT), le)
        n > 0 => getm(rst x, concat(frst(x) :: OUT, le), n - 1)
        concat(DOTS,le)

      showElements(count: NNI, x: %): OUT ==
        -- compute count elements
        y := x
        for i in 1..count while not empty? y repeat y := rst y
        fc := findCycle(count, x)
        not fc.cycle? => bracket reverse! getm(x, empty(), count)
        le : L OUT := empty()
        for i in 1..fc.prefix repeat
          le := concat(first(x) :: OUT, le)
          x := rest x
        pp : OUT :=
          fc.period = 1 => overbar(frst(x) :: OUT)
          pl : L OUT := empty()
          for i in 1..fc.period repeat
            pl := concat(frst(x) :: OUT, pl)
            x  := rest x
          overbar commaSeparate reverse! pl
        bracket reverse! concat(pp, le)

      streamCountCoerce x ==
      -- this will not necessarily display all stream elements
      -- which have been computed
        count : NNI := _$streamCount$Lisp
        showElements(count, x)

      listm(x, le, n) ==
        explicitlyEmpty? x => le
        lazy? x =>
          n > 0 =>
            empty? x => le
            listm(rst x, concat(frst(x) :: OUT, le), n-1)
          concat(DOTS,le)
        listm(rst x, concat(frst(x) :: OUT, le), n-1)

      showAllElements x ==
      -- this will display all stream elements which have been computed
      -- and will display at least n elements with n = streamCount$Lisp
        extend(x, _$streamCount$Lisp)
        cycElt := cycleElt x
        cycElt case "failed" =>
          le := listm(x, empty(), _$streamCount$Lisp)
          bracket reverse! le
        cycEnt := computeCycleEntry(x, cycElt@%)
        le : L OUT := empty()
        while not eq?(x, cycEnt) repeat
          le := concat(frst(x) :: OUT, le)
          x := rst x
        len := computeCycleLength(cycElt :: %)
        pp : OUT :=
          len = 1 => overbar(frst(x) :: OUT)
          pl : L OUT := []
          for i in 1..len repeat
            pl := concat(frst(x) :: OUT, pl)
            x := rst x
          overbar commaSeparate reverse! pl
        bracket reverse! concat(pp, le)

      showAll?() == _$streamsShowAll$Lisp

      coerce(x) : OUT ==
        showAll?() => showAllElements x
        streamCountCoerce x

--% AGG functions

    lazyCopy : % -> %
    lazyCopy x == delay
      empty? x => empty()
      concat(frst x, copy rst x)

    copy x ==
      cycElt := cycleElt x
      cycElt case "failed" => lazyCopy x
      ce := cycElt@%
      len := computeCycleLength(ce)
      e := computeCycleEntry(x, ce)
      d := distance(x, e)
      cycle := complete first(e, len)
      setrst!(tail cycle, cycle)
      d = 0 => cycle
      head := complete first(x, d::NNI)
      setrst!(tail head, cycle)
      head

--% CLAGG functions

    construct l == APPEND(l, empty())$Lisp

--% ELTAGG functions

    elt(x : %, n : I) ==
      -- copied from defaults to avoid loading defaults
      n < MIN or empty? x => error "elt: no such element"
      n = MIN => frst x
      elt(rst x, n - 1)

    seteltt : (%, I, S) -> S
    seteltt(x, n, s) ==
      n = MIN => setfrst!(x, s)
      seteltt(rst x, n - 1, s)

    setelt!(x, n : I, s : S) ==
      n < MIN or empty? x => error "setelt!: no such element"
      x := expand!(x, n - MIN + 1)
      seteltt(x, n, s)

--% IXAGG functions

    removee : ((S -> Boolean), %) -> %
    removee(p, x) == delay
      empty? x => empty()
      p(frst x) => remove(p, rst x)
      concat(frst x, remove(p, rst x))

    remove(p : S -> Boolean, x) ==
      explicitlyEmpty? x => empty()
      eq?(x, rst x) =>
        p(frst x) => empty()
        x
      removee(p, x)

    selectt : ((S -> Boolean), %) -> %
    selectt(p, x) == delay
      empty? x => empty()
      not p(frst x) => select(p, rst x)
      concat(frst x, select(p, rst x))

    select(p, x) ==
      explicitlyEmpty? x => empty()
      eq?(x, rst x) =>
        p(frst x) => x
        empty()
      selectt(p, x)

    map(f, x) ==
      map(f, x pretend Stream(S))$StreamFunctions2(S, S) pretend %

    map(g, x, y) ==
      xs := x pretend Stream(S); ys := y pretend Stream(S)
      map(g, xs, ys)$StreamFunctions3(S, S, S) pretend %

    fill!(x, s) ==
      setfrst!(x, s)
      setrst!(x, x)

    map!(f, x) ==
    -- too many problems with map! on a lazy stream, so
    -- in this case, an error message is returned
      cyclic? x =>
        tail := cycleTail x ; y := x
        until y = tail repeat
          setfrst!(y, f frst y)
          y := rst y
        x
      explicitlyFinite? x =>
        y := x
        while not empty? y repeat
          setfrst!(y, f frst y)
          y := rst y
        x
      error "map!: stream with lazy evaluation"

    swap!(x, m, n) ==
      (not index?(m, x)) or (not index?(n, x)) =>
        error "swap!: no such elements"
      x := expand!(x, max(m, n) - MIN + 1)
      xm := elt(x, m); xn := elt(x, n)
      setelt!(x, m, xn); setelt!(x, n, xm)
      x

--% LNAGG functions

    concat(x : %, s : S) == delay
      empty? x => concat(s, empty())
      concat(frst x, concat(rst x, s))

    concat(x : %, y : %) == delay
      empty? x => copy y
      concat(frst x, concat(rst x, y))

    concat l == delay
      empty? l => empty()
      empty?(x := first l) => concat rest l
      concat(frst x, concat(rst x, concat rest l))

    setelt!(x, seg : U, s : S) ==
      l := low(seg)
      hasHi seg =>
        h := high(seg)
        h < l => s
        (not index?(l, x)) or (not index?(h, x)) =>
          error "setelt!: index out of range"
        x := expand!(x, h - MIN + 1)
        y := rest(x, (l - MIN) :: NNI)
        for i in 0..(h - l) repeat
          setfrst!(y, s)
          y := rst y
        s
      not index?(l, x) => error "setelt!: index out of range"
      x := rest(x, (l - MIN) :: NNI)
      setrst!(x, x)
      setfrst!(x, s)

--% RCAGG functions

    empty() == [NullStream, NIL$Lisp]

    -- we have to use SPADCALL directly to avoid wrong code
    lazyEval x == SPADCALL(rst(x))$Lisp pretend %

    lazyEvaluate x ==
      st := lazyEval x
      setfrst!(x, frst st)
      setrst!(x, if EQ(rst st, st)$Lisp then x else rst st)
      x

    -- empty? is the only function that explicitly causes evaluation
    -- of a stream element
    empty? x ==
      while lazy? x repeat
        st := lazyEval x
        setfrst!(x, frst st)
        setrst!(x, if EQ(rst st, st)$Lisp then x else rst st)
      uninitialized? x => error "Trying to use uninitialized stream"
      explicitlyEmpty? x

    --setvalue(x, s) == setfirst!(x, s)

    --setchildren(x, l) ==
      --empty? l => error "setchildren: empty list of children"
      --not(empty? rest l) => error "setchildren: wrong number of children"
      --setrest!(x, first l)

--% URAGG functions

    first(x, n) == delay
    -- former name: take
      n = 0 or empty? x => empty()
      (concat(frst x, first(rst x, (n-1) :: NNI)))

    concat(s : S, x : %) == [s, x]
    cons(s, x) == concat(s, x)

    cycleSplit! x ==
      cycElt := cycleElt x
      cycElt case "failed" =>
        error "cycleSplit!: non-cyclic stream"
      y := computeCycleEntry(x, cycElt@%)
      eq?(x, y) => (setToNil! x; return y)
      z := rst x
      repeat
        eq?(y, z) => (setrest!(x, empty()); return y)
        x := z ; z := rst z

    expand!(x, n) ==
    -- expands cycles (if necessary) so that the first n
    -- elements of x will not be part of a cycle
      n < 1 => x
      y := x
      for i in 1..n while not empty? y repeat y := rst y
      cycElt := cycleElt x
      cycElt case "failed" => x
      e := computeCycleEntry(x, cycElt@%)
      d : I := distance(x, e)
      d >= n => x
      if d = 0 then
        -- roll the cycle 1 entry
        d := 1
        t := cycleTail e
        if eq?(t, e) then
          t := concat(frst t, empty())
          e := setrst!(t, t)
          setrst!(x, e)
        else
          setrst!(t, concat(frst e, rst e))
          e := rst e
      nLessD := (n-d) :: NNI
      y := complete first(e, nLessD)
      e := rest(e, nLessD)
      setrst!(tail y, e)
      setrst!(rest(x, (d-1) :: NNI), y)
      x

    first x ==
      empty? x => error "Can't take the first of an empty stream."
      frst x

    concat!(x : %, y : %) ==
      empty? x => y
      setrst!(tail x, y)

    concat!(x : %, s : S) ==
      concat!(x, concat(s, empty()))

    setfirst!(x, s) == setelt!(x, 0, s)
    setelt!(x, "first", s) == setfirst!(x, s)
    setrest!(x, y) ==
      empty? x => error "setrest!: empty stream"
      setrst!(x, y)
    setelt!(x, "rest", y) == setrest!(x, y)

    setlast!(x, s) ==
      empty? x => error "setlast!: empty stream"
      setfrst!(tail x, s)
    setelt!(x, "last", s) == setlast!(x, s)

    split!(x, n) ==
      n < MIN => error "split!: index out of range"
      n = MIN =>
        y : % := empty()
        setfrst!(y, frst x)
        setrst!(y, rst x)
        setToNil! x
        y
      x := expand!(x, n - MIN)
      x := rest(x, (n - MIN - 1) :: NNI)
      y := rest x
      setrst!(x, empty())
      y

--% STREAM functions

    coerce(l : L S) == construct l

    repeating l ==
      empty? l =>
        error "Need a non-null list to make a repeating stream."
      x0 : % := x := construct l
      while not empty? rst x repeat x := rst x
      setrst!(x, x0)

    if S has SetCategory then

      repeating?(l, x) ==
        empty? l =>
          error "Need a non-empty? list to make a repeating stream."
        empty? rest l =>
          not empty? x and frst x = first l and x = rst x
        x0 := x
        for s in l repeat
          empty? x or s ~= frst x => return false
          x := rst x
        eq?(x, x0)

    findCycle(n, x) ==
      hd := x
      -- Determine whether periodic within n.
      tl := rest(x, n)
      explicitlyEmpty? tl => [false, 0, 0]
      i := 0; while not eq?(x, tl) repeat (x := rst x; i := i + 1)
      i = n => [false, 0, 0]
      -- Find period. Now x=tl, so step over and find it again.
      x := rst x; per := 1
      while not eq?(x, tl) repeat (x := rst x; per := per + 1)
      -- Find non-periodic part.
      x := hd; xp := rest(hd, per); npp := 0
      while not eq?(x, xp) repeat (x := rst x; xp := rst xp; npp := npp+1)
      [true, npp, per]

    delay(fs : ()->%) == [NonNullStream, fs pretend %]

--     explicitlyEmpty? x == markedNull? x

    explicitEntries? x ==
      not explicitlyEmpty? x and not lazy? x

    numberOfComputedEntries x ==
        count := 0
        while explicitEntries? x repeat
            count := count + 1
            x := rst x
        count

    setrestt!(x, n, y) ==
      n = 0 => setrst!(x, y)
      setrestt!(rst x, n-1, y)

    setrest!(x, n, y) ==
      n < 0 or empty? x => error "setrest!: no such rest"
      x := expand!(x, n+1)
      setrestt!(x, n, y)

    stream f    == delay concat(f(), stream f)
    gen : (S -> S, S) -> %
    gen(f, s) == delay(ss := f s; concat(ss, gen(f, ss)))
    stream(f, s)==concat(s, gen(f, s))

    concat(x : %, y : %) ==delay
      empty? x => y
      concat(frst x, concat(rst x, y))

    swhilee : (S -> Boolean, %) -> %
    swhilee(p, x) == delay
      empty? x      => empty()
      not p(frst x) => empty()
      concat(frst x, filterWhile(p, rst x))
    filterWhile(p, x)==
      explicitlyEmpty? x => empty()
      eq?(x, rst x) =>
        p(frst x) => x
        empty()
      swhilee(p, x)

    suntill : (S -> Boolean, %) -> %
    suntill(p, x) == delay
      empty? x  => empty()
      p(frst x) => concat(frst x, empty())
      concat(frst x, filterUntil(p, rst x))

    filterUntil(p, x)==
      explicitlyEmpty? x => empty()
      eq?(x, rst x) =>
        p(frst x) => concat(frst x, empty())
        x
      suntill(p, x)

--% STAGG functions

  -- local
    ms(m: I, n: I, s: %): % == delay
      empty? s => empty()
      zero? n => concat(frst s, ms(m, m-1, rst s))
      ms(m, n-1, rst s)

    -- local
    eltPositiveStep(x : %, seg : U): % == delay
      step := incr seg
      lo := low seg
      hasHi seg =>
        hi := high seg
        hi < lo => empty()
        hi := lo + step*((hi-lo) quo step)
        z := first(rest(x, (lo - MIN) :: NNI), (hi - lo + 1) :: NNI)
        one? step => z
        ms(step, 0, z)
      z := rest(x, (lo - MIN) :: NNI)
      one? step => copy z
      ms(step, 0, z)

    -- local
    errorStream(): % == delay error "elt: no evaluation possible"

    -- local
    eltNegativeStep(x : %, seg : U): % == delay
      step := - incr seg
      hi := low seg
      lo := if hasHi seg then high seg else MIN
      lo > hi => empty()
      lo := hi - step*((hi-lo) quo step) -- adapt to exact bounds
      mustEventuallyFail?: Boolean := lo < MIN
      if mustEventuallyFail? then
        lo := hi - step*((hi-MIN) quo step) -- adapt to exact bounds
      z := rest(x, (lo - MIN) :: NNI)
      l: % := empty()
      while lo < hi repeat
        l := concat(first z, l)
        z := rest(z, step :: NonNegativeInteger)
        lo := lo + step
      result := concat(first z, l)
      -- If mustEventuallyFail? then we would eventually access a
      -- non-existing stream element of x, so we create a finite
      -- stream z of n elements that will give an error for
      -- "empty?(rest(z, n)). This signals that according to the
      -- creation that stream would not be empty, but the next element
      -- would access x(k) for k<MIN.
      mustEventuallyFail? => concat(result, errorStream())
      result

    elt(x : %, seg : U): % ==
      step := incr seg
      zero? step => error "zero step size"
      step > 0 => eltPositiveStep(x, seg)
      eltNegativeStep(x, seg)

--  if S has SetCategory then
--    mapp: ((S, S) -> S, %, %, S) -> %
--    mapp(f, x, y, a) == delay
--      empty? x or empty? y => empty()
--      concat(f(frst x, frst y), map(f, rst x, rst y, a))
--      map(f, x, y, a) ==
--      explicitlyEmpty? x => empty()
--      eq?(x, rst x) =>
--        frst x=a => y
--        map(f(frst x, #1), y)
--      explicitlyEmpty? y => empty()
--      eq?(y, rst y) =>
--        frst y=a => x
--        p(f(#1, frst y), x)
--      mapp(f, x, y, a)

)abbrev package STREAM1 StreamFunctions1
++ Authors: Burge, Watt; updated by Clifton J. Williamson
++ Date Created: July 1986
++ Keywords: stream, infinite list, infinite sequence
StreamFunctions1(S : Type) : Exports == Implementation where
  ++ Functions defined on streams with entries in one set.
  ST  ==> Stream

  Exports ==> with
    concat : ST ST S -> ST S
      ++ concat(u) returns the left-to-right concatenation of the streams in u.
      ++ Note: \spad{concat(u) = reduce(concat, u)}.

  Implementation ==> add

    concat z == delay
      empty? z => empty()
      empty?(x := frst z) => concat rst z
      concat(frst x, concat(rst x, concat rst z))

)abbrev package STREAM2 StreamFunctions2
++ Authors: Burge, Watt; updated by Clifton J. Williamson
++ Date Created: July 1986
++ Keywords: stream, infinite list, infinite sequence
StreamFunctions2(A : Type, B : Type) : Exports == Implementation where
  ++ Functions defined on streams with entries in two sets.
  ST   ==> Stream

  Exports ==> with
    map : ((A -> B), ST A) -> ST B
      ++ map(f, s) returns a stream whose elements are the function f applied
      ++ to the corresponding elements of s.
      ++ Note: \spad{map(f, [x0, x1, x2, ...]) = [f(x0), f(x1), f(x2), ..]}.
    scan : (B, ((A, B) -> B), ST A) -> ST B
      ++ scan(b, h, [x0, x1, x2, ...]) returns \spad{[y0, y1, y2, ...]}, where
      ++ \spad{y0 = h(x0, b)},
      ++ \spad{y1 = h(x1, y0)}, \spad{...}
      ++ \spad{yn = h(xn, y(n-1))}.
    reduce :  (B, (A, B) -> B, ST A) -> B
      ++ reduce(b, f, u), where u is a finite stream \spad{[x0, x1, ..., xn]},
      ++ returns the value \spad{r(n)} computed as follows:
      ++ \spad{r0 = f(x0, b),
      ++ r1 = f(x1, r0), ...,
      ++ r(n) = f(xn, r(n-1))}.
--  rreduce: (B, (A, B) -> B, ST A) -> B
--    ++ reduce(b, h, [x0, x1, .., xn]) = h(x1, h(x2(.., h(x(n-1), h(xn, b))..)
--  reshape: (ST B, ST A) -> ST B
--    ++ reshape(y, x) = y

  Implementation ==> add

    mapp : (A -> B, ST A) -> ST B
    mapp(f, x)== delay
      empty? x => empty()
      concat(f frst x, map(f, rst x))

    map(f, x) ==
      explicitlyEmpty? x => empty()
      eq?(x, rst x) => repeating([f frst x])
      mapp(f, x)

--  reshape(y, x) == y

    scan(b, h, x) == delay
      empty? x => empty()
      c := h(frst x, b)
      concat(c, scan(c, h, rst x))

    reduce(b, h, x) ==
      empty? x => b
      reduce(h(frst x, b), h, rst x)
--  rreduce(b, h, x) ==
--    empty? x => b
--    h(frst x, rreduce(b, h, rst x))

)abbrev package STREAM3 StreamFunctions3
++ Authors: Burge, Watt; updated by Clifton J. Williamson
++ Date Created: July 1986
++ Keywords: stream, infinite list, infinite sequence
StreamFunctions3(A, B, C) : Exports == Implementation where
  ++ Functions defined on streams with entries in three sets.
  A  : Type
  B  : Type
  C  : Type
  ST ==> Stream

  Exports ==> with
    map : ((A, B) -> C, ST A, ST B) -> ST C
      ++ map(f, st1, st2) returns the stream whose elements are the
      ++ function f applied to the corresponding elements of st1 and st2.
      ++ Note: \spad{map(f, [x0, x1, x2, ..], [y0, y1, y2, ..]) = [f(x0, y0), f(x1, y1), ..]}.

  Implementation ==> add

    mapp : ((A, B) -> C, ST A, ST B) -> ST C
    mapp(g, x, y) == delay
      empty? x or empty? y => empty()
      concat(g(frst x, frst y), map(g, rst x, rst y))

    map(g, x, y) ==
      explicitlyEmpty? x => empty()
      eq?(x, rst x) => map(z +-> g(frst x, z), y)$StreamFunctions2(B, C)
      explicitlyEmpty? y => empty()
      eq?(y, rst y) => map(z +-> g(z, frst y), x)$StreamFunctions2(A, C)
      mapp(g, x, y)

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
