axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / STREAM.spad

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

Stream(S) : SIG == CODE where
  S : Type

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

  SIG ==> LazyStreamAggregate(S) with

    shallowlyMutable
      ++ one may destructively alter a stream by assigning new
      ++ values to its entries.

    coerce : L S -> %
      ++ coerce(l) converts a list l to a stream.
      ++
      ++X m:=[1,2,3,4,5,6,7,8,9,10,11,12]
      ++X coerce(m)@Stream(Integer)
      ++X m::Stream(Integer)

    repeating : L S -> %
      ++ repeating(l) is a repeating stream whose period is the list l.
      ++
      ++X m:=repeating([-1,0,1,2,3])

    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.
        ++
        ++X m:=[1,2,3]
        ++X n:=repeating(m)
        ++X repeating?(m,n)

    findCycle : (NNI,%) -> Record(cycle?: B, prefix: NNI, period: NNI)
      ++ findCycle(n,st) determines if st is periodic within n.
      ++
      ++X m:=[1,2,3]
      ++X n:=repeating(m)
      ++X findCycle(3,n)
      ++X findCycle(2,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)}.
      ++
      ++X m:=[1,2,3]
      ++X n:=repeating(m)
      ++X cons(4,n)

    if S has SetCategory then

      output : (I, %) -> Void
        ++ output(n,st) computes and displays the first n entries
        ++ of st.
        ++
        ++X m:=[1,2,3]
        ++X n:=repeating(m)
        ++X output(5,n)

      showAllElements : % -> OUT
        ++ showAllElements(s) creates an output form which displays all
        ++ computed elements.
        ++
        ++X m:=[1,2,3,4,5,6,7,8,9,10,11,12]
        ++X n:=m::Stream(PositiveInteger)
        ++X showAllElements n

      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.
      ++
      ++X p:=[i for i in 1..]
      ++X q:=[i for i in 9..]
      ++X setrest!(p,4,q)
      ++X p

    generate : (() -> S) -> %
      ++ generate(f) creates an infinite stream all of whose elements are
      ++ equal to \spad{f()}.
      ++ Note: \spad{generate(f) = [f(),f(),f(),...]}.
      ++
      ++X f():Integer == 1
      ++X generate(f)

    generate : (S -> S,S) -> %
      ++ generate(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{generate(f,x) = [x,f(x),f(f(x)),...]}.
      ++
      ++X f(x:Integer):Integer == x+10
      ++X generate(f,10)

    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}.
      ++
      ++X m:=[i for i in 1..]
      ++X f(x:PositiveInteger):Boolean ==  x < 5
      ++X filterWhile(f,m)

    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}.
      ++
      ++X m:=[i for i in 1..]
      ++X f(x:PositiveInteger):Boolean ==  x < 5
      ++X filterUntil(f,m)

  CODE ==> add

    MIN ==> 1  -- minimal stream index; see also the defaults in LZSTAGG
    x:%

    import 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: () -> %]
    -- Could use a record of unions if we could guarantee no tags.

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

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

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

    explicitlyEmpty? x == EQ(frst x,NullStream)$Lisp

    lazy? x            == EQ(frst x,NonNullStream)$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(message("..."),le)
        eq?(x,rst x) => concat(overbar(frst(x) :: OUT),le)
        n > 0 => getm(rst x,concat(frst(x) :: OUT,le),n - 1)
        concat(message("..."),le)

      streamCountCoerce x ==
      -- this will not necessarily display all stream elements
      -- which have been computed
        count := _$streamCount$Lisp
        -- 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)

      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(message("..."),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?() ==
        NULL(_$streamsShowAll$Lisp)$Lisp => false
        true

      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

--% CNAGG functions

    construct l ==
      -- copied from defaults to avoid loading defaults
      empty? l => empty()
      concat(first l, construct rest l)

--% 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,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) ==
      low := lo seg
      hasHi seg =>
        high := hi seg
        high < low => s
        (not index?(low,x)) or (not index?(high,x)) =>
          error "setelt: index out of range"
        x := expand_!(x,high - MIN + 1)
        y := rest(x,(low - MIN) :: NNI)
        for i in 0..(high-low) repeat
          setfrst_!(y,s)
          y := rst y
        s
      not index?(low,x) => error "setelt: index out of range"
      x := rest(x,(low - MIN) :: NNI)
      setrst_!(x,x)
      setfrst_!(x,s)

--% RCAGG functions

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

    lazyEval x == (rst(x):(()-> %)) ()

    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)
      explicitlyEmpty? x

--% 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 %]

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

    numberOfComputedEntries x ==
      explicitEntries? x => numberOfComputedEntries(rst x) + 1
      0

    if S has SetCategory then

      output(n,x) ==
        (not(n>0))or empty? x => void()
        mathPrint(frst(x)::OUT)$Lisp
        output(n-1, rst x)

    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)

    generate f    == delay concat(f(), generate f)

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

    generate(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)