)abbrev domain ILIST IndexedList
++ Author: Michael Monagan
++ Date Created: Sep 1987
++ Basic Operations:
++   \#, concat, concat!, construct, copy, elt, empty,
++   empty?, eq?, first, member?, merge!, mergeSort, minIndex,
++   parts, removeDuplicates!, rest, reverse, reverse!,
++   setelt, setfirst!, setrest!, sort!, split!
++ Related Constructors: List
++ Also See:
++ AMS Classification:
++ Keywords: list, aggregate, index
++ Description:
++   \spadtype{IndexedList} is a basic implementation of
++   \spadtype{ListAggregate}, often using functions in the underlying
++   LISP system. The second parameter to the constructor (\spad{mn})
++   is the beginning index of the list. That is, if \spad{l} is a
++   list, then \spad{elt(l, mn)} is the first value. This constructor
++   is probably best viewed as the implementation of singly-linked
++   lists that are addressable by index rather than as a mere wrapper
++   for LISP lists.
IndexedList(S : Type, mn : Integer) : Exports == Implementation where
 cycleMax ==> 1000        -- value used in checking for cycles

-- The following seems to be a bit out of date, but is kept in case
-- a knowledgeable person wants to update it:
--   The following LISP dependencies are divided into two groups
--   Those that are required
--   CONS, EQ, NIL, NULL, QCAR, QCDR, RPLACA, RPLACD
--   Those that are included for efficiency only
--   NEQ, LIST, CAR, CDR, NCONC2, NREVERSE, LENGTH
--   Also REVERSE, since it's called in Polynomial Ring

 Qfirst  ==> QCAR$Lisp
 Qrest   ==> QCDR$Lisp
 Qempty? ==> NULL$Lisp
 Qempty  ==> NIL$Lisp
 Qeq     ==> EQ$Lisp
 Qcons   ==> CONS$Lisp
 Qset_first ==> qset_first$Lisp
 Qset_rest ==> qset_rest$Lisp
 Qreverse! ==> NREVERSE$Lisp

 Exports ==> ListAggregate S
 Implementation ==>
  add
   #x                  == LENGTH(x)$Lisp
   concat(s : S, x : %)     == Qcons(s, x)
   eq?(x, y)            == EQ(x, y)$Lisp
   first x             == SPADfirst(x)$Lisp
   elt(x,"first")      == SPADfirst(x)$Lisp
   empty()             == Qempty
   empty? x            == Qempty?(x)
   rest x              == CDR(x)$Lisp
   elt(x,"rest")       == CDR(x)$Lisp
   setfirst!(x, s)     ==
      Qempty?(x) => error "Cannot update an empty list"
      Qset_first(x, s)
   qsetfirst!(x, s)    == Qset_first(x, s)
   setelt!(x, "first", s) ==
      Qempty?(x) => error "Cannot update an empty list"
      Qset_first(x, s)
   setrest!(x, y)      ==
      Qempty?(x) => error "Cannot update an empty list"
      Qset_rest(x, y)
   qsetrest!(x, y)     == Qset_rest(x, y)
   setelt!(x, "rest", y)  ==
      Qempty?(x) => error "Cannot update an empty list"
      Qset_rest(x, y)
   construct l         == l pretend %
   parts s             == s pretend List S
   reverse! x         == Qreverse!(x)
   reverse x           == REVERSE(x)$Lisp
   minIndex x          == mn

   rest(x, n) ==
      for i in 1..n repeat
         if Qempty?(x) then error "index out of range"
         x := Qrest x
      x

   copy x ==
      y : % := Qempty
      for i in 0.. while not Qempty?(x) repeat
         if Qeq(i,cycleMax) and cyclic? x then error "cyclic list"
         y := Qcons(Qfirst x, y)
         x := Qrest x
      Qreverse!(y)

   leaves x ==
       empty? x => Qempty
       for i in 0.. while not Qempty? x repeat
           Qeq(i, cycleMax) and cyclic? x => error "cyclic list"
           leaf? x => return [value x]
           x := Qrest x

   if S has CoercibleTo(OutputForm) then

     coerce(x) : OutputForm ==
        -- displays cycle with overbar over the cycle
        y := (Qempty)@List(OutputForm)
        s := cycleEntry x
        while not(Qeq(x, s)) repeat
          y := concat((first x)::OutputForm, y)
          x := rest x
        y := Qreverse! y
        Qempty?(s) => bracket y
        -- cyclic case: z is cyclic part
        z := list((first x)::OutputForm)
        while not(Qeq(s, rest x)) repeat
           x := rest x
           z := concat((first x)::OutputForm, z)
        bracket concat!(y, overbar commaSeparate Qreverse! z)

   if S has BasicType then

     x = y ==
       Qeq(x, y) => true
       while not Qempty?(x) and not Qempty?(y) repeat
          Qfirst x ~=$S Qfirst y => return false
          x := Qrest x
          y := Qrest y
       Qempty?(x) and Qempty?(y)

     member?(s, x) ==
        while not Qempty?(x) repeat
           if s = Qfirst x then return true else x := Qrest x
        false

   if S has SetCategory then
     latex(x : %) : String ==
       s : String := "\left["
       while not Qempty?(x) repeat
         s := concat(s, latex(Qfirst x)$S)$String
         x := Qrest x
         if not Qempty?(x) then s := concat(s, ", ")$String
       concat(s, " \right]")$String

     hashUpdate!(s : HashState, x : %) : HashState ==
         while not Qempty?(x) repeat
             s := hashUpdate!(s, Qfirst x)
             x := Qrest x
         s

   -- Lots of code from parts of AGGCAT, repeated here to
   -- get faster compilation
   concat!(x : %, y : %) ==
      Qempty?(x) => y
      z := x
      while not Qempty?(Qrest(z)) repeat
        z := Qrest z
      Qset_rest(z, y)
      x

   -- Then a quicky:
   if S has BasicType then
     removeDuplicates! l ==
       p := l
       while not Qempty?(p) repeat
         pp := p
         f : S := Qfirst p
         p := Qrest p
         pr : %
         while not Qempty?(pr := Qrest(pp)) repeat
           if (Qfirst pr)@S = f then Qset_rest(pp, Qrest pr)
           else pp := pr
       l

   -- then sorting
   mergeSort : ((S, S) -> Boolean, %, Integer) -> %

   sort!(f, l)       == mergeSort(f, l, #l)

   merge!(f, p, q) ==
     Qempty?(p) => q
     Qempty?(q) => p
     Qeq(p, q) => error "cannot merge a list into itself"
     if f(Qfirst p, Qfirst q)
       then (r := t := p; p := Qrest p)
       else (r := t := q; q := Qrest q)
     while not Qempty?(p) and not Qempty?(q) repeat
       if f(Qfirst p, Qfirst q)
         then (Qset_rest(t, p); t := p; p := Qrest p)
         else (Qset_rest(t, q); t := q; q := Qrest q)
     Qset_rest(t, if Qempty?(p) then q else p)
     r

   split!(p, n) ==
      n < 1 => error "index out of range"
      p := rest(p, (n - 1)::NonNegativeInteger)
      q : % := Qrest p
      Qset_rest(p, Qempty)
      q

   mergeSort(f, p, n) ==
     if n = 2 and f(first rest p, first p) then p := Qreverse! p
     n < 3 => p
     l := (n quo 2)::NonNegativeInteger
     q := split!(p, l)
     p := mergeSort(f, p, l)
     q := mergeSort(f, q, n - l)
     merge!(f, p, q)


)abbrev domain LIST List
++ Author: Michael Monagan
++ Date Created: Sep 1987
++ Basic Operations:
++   \#, append, concat, concat!, cons, construct, copy, elt,
++   empty, empty?, eq?, first, member?, merge!, mergeSort, minIndex,
++   parts, removeDuplicates!, rest, reverse,
++   reverse!, setDifference, setIntersection, setUnion, setelt,
++   setfirst!, setrest!, sort!, split!
++ Related Constructors: ListFunctions2, ListFunctions3, ListToMap
++ Also See: IndexList, ListAggregate
++ AMS Classification:
++ Keywords: list, index, aggregate, lisp
++ Description:
++   \spadtype{List} implements singly-linked lists that are
++   addressable by indices; the index of the first element
++   is 1. In addition to the operations provided by
++   \spadtype{IndexedList}, this constructor provides some
++   LISP-like functions such as \spadfun{cons} and \spadfun{append}.
List(S : Type) : Exports == Implementation where
 LISTMININDEX ==> 1       -- this is the minimum list index

 Exports ==> ListAggregate S with
  cons            : (S, %) -> %
    ++ cons(element, u) appends \spad{element} onto the front
    ++ of list \spad{u} and returns the new list. This new list
    ++ and the old one will share some structure.
  append          : (%, %) -> %
    ++ append(u1, u2) appends the elements of list \spad{u1}
    ++ onto the front of list \spad{u2}. This new list
    ++ and \spad{u2} will share some structure.
  tails : % -> List(%)
    ++ tails(u) returns list [rest(u, 0), rest(u, 1), ..., rest(u, #u - 1)].
  if S has BasicType then
    setUnion        : (%, %) -> %
      ++ setUnion(u1, u2) appends the two lists u1 and u2, then
      ++ removes all duplicates. The order of elements in the
      ++ resulting list is unspecified.
    setIntersection : (%, %) -> %
      ++ setIntersection(u1, u2) returns a list of the elements
      ++ that lists \spad{u1} and \spad{u2} have in common.
      ++ The order of elements in the resulting list is unspecified.
    setDifference   : (%, %) -> %
      ++ setDifference(u1, u2) returns a list of the elements
      ++ of \spad{u1} that are not also in \spad{u2}.
      ++ The order of elements in the resulting list is unspecified.
  if S has OpenMath then OpenMath

 Implementation ==>
   IndexedList(S, LISTMININDEX) add
      cons(s, l)               == concat(s, l)
      append(l : %, t : %)         == concat(l, t)
      tails(x : %) : List(%) ==
          [rest(x, i) for i in 0..(#x - 1)]

      if S has OpenMath then
        writeOMList(dev : OpenMathDevice, x : %) : Void ==
          OMputApp(dev)
          OMputSymbol(dev, "list1", "list")
          -- The following didn't compile because the compiler isn't
          -- convinced that `xval' is a S.  Duhhh! MCD.
          --for xval in x repeat
          --  OMwrite(dev, xval, false)
          while not empty?(x) repeat
            OMwrite(dev, first x, false)
            x := rest x
          OMputEndApp(dev)

        OMwrite(dev : OpenMathDevice, x : %, wholeObj : Boolean) : Void ==
          if wholeObj then
            OMputObject(dev)
          writeOMList(dev, x)
          if wholeObj then
            OMputEndObject(dev)

      if S has BasicType then
        setUnion(l1 : %, l2 : %)      == removeDuplicates concat(l1, l2)

        setIntersection(l1 : %, l2 : %) ==
          u : % := empty()
          l1 := removeDuplicates l1
          while not empty? l1 repeat
            if member?(first l1, l2) then u := cons(first l1, u)
            l1 := rest l1
          u

        setDifference(l1 : %, l2 : %) ==
          l1 := removeDuplicates l1
          empty? l2 => l1
          lu : % := empty()
          while not empty? l1 repeat
            l11 := l1.1
            if not member?(l11, l2) then lu := concat(l11, lu)
            l1 := rest l1
          lu

      -- we repeat definition from category to allow optimization
      map!(f, l) ==
          y := l
          while not empty? l repeat
              setfirst!(l, f first l)
              l := rest l
          y

      if S has ConvertibleTo InputForm then
        convert(x : %) : InputForm ==
          convert concat(convert('construct)@InputForm,
                [convert a for a in (x pretend List S)]$List(InputForm))


)abbrev package LIST2 ListFunctions2
++ Author:
++ Basic Operations: map, reduce, scan
++ Related Constructors: List
++ Also See: ListFunctions3
++ AMS Classification:
++ Keywords: list, aggregate, map, reduce
++ Description:
++   \spadtype{ListFunctions2} implements utility functions that
++   operate on two kinds of lists, each with a possibly different
++   type of element.
ListFunctions2(A : Type, B : Type) : public == private where
  LA     ==> List A
  LB     ==> List B
  O2     ==> FiniteLinearAggregateFunctions2(A, LA, B, LB)

  public ==> with
    scan :    ((A, B) -> B, LA, B) -> LB
      ++ scan(fn, u, ident) successively uses the binary function
      ++ \spad{fn} to reduce more and more of list \spad{u}.
      ++ \spad{ident} is returned if the \spad{u} is empty.
      ++ The result is a list of the reductions at each step. See
      ++ \spadfun{reduce} for more information. Examples:
      ++ \spad{scan(fn, [1, 2], 0) = [fn(2, fn(1, 0)), fn(1, 0)]} and
      ++ \spad{scan(*, [2, 3], 1) = [2 * 1, 3 * (2 * 1)]}.
    reduce :  ((A, B) -> B, LA, B) -> B
      ++ reduce(fn, u, ident) successively uses the binary function
      ++ \spad{fn} on the elements of list \spad{u} and the result
      ++ of previous applications. \spad{ident} is returned if the
      ++ \spad{u} is empty. Note the order of application in
      ++ the following examples:
      ++ \spad{reduce(fn, [1, 2, 3], 0) = fn(3, fn(2, fn(1, 0)))} and
      ++ \spad{reduce(*, [2, 3], 1) = 3 * (2 * 1)}.
    map :      (A -> B, LA) -> LB
      ++ map(fn, u) applies \spad{fn} to each element of
      ++ list \spad{u} and returns a new list with the results.
      ++ For example \spad{map(square, [1, 2, 3]) = [1, 4, 9]}.

  private ==> add
    map(f, l)       == map(f, l)$O2
    scan(f, l, b)   == scan(f, l, b)$O2
    reduce(f, l, b) == reduce(f, l, b)$O2

)abbrev package LIST3 ListFunctions3
++ Author:
++ Basic Operations: map
++ Related Constructors: List
++ Also See: ListFunctions2
++ AMS Classification:
++ Keywords: list, aggregate, map
++ Description:
++   \spadtype{ListFunctions3} implements utility functions that
++   operate on three kinds of lists, each with a possibly different
++   type of element.
ListFunctions3(A : Type, B : Type, C : Type) : public == private where
  LA     ==> List A
  LB     ==> List B
  LC     ==> List C

  public ==> with
    map : ((A, B) -> C, LA, LB) -> LC
      ++ map(fn, u1, u2) applies the binary function \spad{fn}
      ++ to corresponding elements of lists \spad{u1} and \spad{u2}
      ++ and returns a list of the results (in the same order). Thus
      ++ \spad{map(/, [1, 2, 3], [4, 5, 6]) = [1/4, 2/5, 1/2]}. The computation
      ++ terminates when the end of either list is reached. That is,
      ++ the length of the result list is equal to the minimum of the
      ++ lengths of \spad{u1} and \spad{u2}.

  private ==> add
    map(fn : (A, B) -> C, la : LA, lb : LB) : LC ==
        [fn(a, b) for a in la for b in lb]

)abbrev package LIST2MAP ListToMap
++ Author: Manuel Bronstein
++ Date Created: 22 Mar 1988
++ Basic Operations: match
++ Related Constructors: List
++ Also See:
++ AMS Classification:
++ Keywords: mapping, list
++ Description:
++   \spadtype{ListToMap} allows mappings to be described by a pair of
++   lists of equal lengths.  The image of an element \spad{x},
++   which appears in position \spad{n} in the first list, is then
++   the \spad{n}th element of the second list.  A default value or
++   default function can be specified to be used when \spad{x}
++   does not appear in the first list.  In the absence of defaults,
++   an error will occur in that case.
ListToMap(A : SetCategory, B : Type) : Exports == Implementation where
  LA  ==> List A
  LB  ==> List B
  AB  ==> (A -> B)

  Exports ==> with
    match : (LA, LB) -> AB
      ++ match(la, lb) creates a map with no default source or target values
      ++ defined by lists la and lb of equal length.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index in lb.
      ++ Error: if la and lb are not of equal length.
      ++ Note: when this map is applied, an error occurs when
      ++ applied to a value missing from la.
    match : (LA, LB, A) -> B
      ++ match(la, lb, a) creates a map
      ++ defined by lists la and lb of equal length, where \spad{a} is used
      ++ as the default source value if the given one is not in \spad{la}.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index in lb.
      ++ Error: if la and lb are not of equal length.
    match : (LA, LB, B)    -> AB
      ++ match(la, lb, b) creates a map
      ++ defined by lists la and lb of equal length, where \spad{b} is used
      ++ as the default target value if the given function argument is
      ++ not in \spad{la}.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index in lb.
      ++ Error: if la and lb are not of equal length.
    match : (LA, LB, A, B) -> B
      ++ match(la, lb, a, b) creates a map
      ++ defined by lists la and lb of equal length,
      ++ and applies this map to a.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index in lb.
      ++ Argument b is the default target value if a is not in la.
      ++ Error: if la and lb are not of equal length.
    match : (LA, LB, AB)    -> AB
      ++ match(la, lb, f) creates a map
      ++ defined by lists la and lb of equal length.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index in lb.
      ++ Argument \spad{f} is used as the
      ++ function to call when the given function argument is not in
      ++ \spad{la}.
      ++ The value returned is f applied to that argument.
    match : (LA, LB, A, AB) -> B
      ++ match(la, lb, a, f) creates a map
      ++ defined by lists la and lb of equal length,
      ++ and applies this map to a.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index in lb.
      ++ Argument \spad{f} is a default function to call if a is not in la.
      ++ The value returned is then obtained by applying f to argument a.

  Implementation ==> add
    match(la, lb)             == (z1 : A) : B +-> match(la, lb, z1)
    match(la : LA, lb : LB, a : A)  == lb.position(a, la)
    match(la : LA, lb : LB, b : B)  == (z1 : A) : B +-> match(la, lb, z1, b)
    match(la : LA, lb : LB, f : AB) == (z1 : A) : B +-> match(la, lb, z1, f)

    match(la : LA, lb : LB, a : A, b : B) ==
      (p := position(a, la)) < minIndex(la) => b
      lb.p

    match(la : LA, lb : LB, a : A, f : AB) ==
      (p := position(a, la)) < minIndex(la) => f a
      lb.p

)abbrev domain ALIST AssociationList
++ Author:
++ Basic Operations: empty, empty?, keys, \#, concat, first, rest,
++   setrest!, search, setelt, remove!
++ Related Constructors:
++ Also See: List
++ AMS Classification:
++ Keywords: list, association list
++ Description:
++   \spadtype{AssociationList} implements association lists. These
++   may be viewed as lists of pairs where the first part is a key
++   and the second is the stored value. For example, the key might
++   be a string with a persons employee identification number and
++   the value might be a record with personnel data.

AssociationList(Key : SetCategory, Entry : Type):
 AssociationListAggregate(Key, Entry) == add
        Pair ==> Record(key : Key, entry : Entry)
        Rep := Reference List Pair

        import from List Pair

        dictionary()            == ref empty()
        empty()                 == dictionary()
        empty? t                == empty? deref t
        entries(t : %) : List(Pair) == deref t
        parts(t : %) : List(Pair)   == deref t
        keys t                  == [k.key for k in deref t]
        # t                     == # deref t
        first(t : %) : Pair         == first deref t
        rest t                  == ref rest deref t
        concat(p : Pair, t : %)     == ref concat(p, deref t)
        setrest!(a : %, b : %)     == ref setrest!(deref a, deref b)
        setfirst!(a : %, p : Pair) == setfirst!(deref a, p)
        minIndex(a : %) : Integer   == minIndex(deref a)
        maxIndex(a : %) : Integer   == maxIndex(deref a)

        search(k, t) ==
          for r in deref t repeat
            k = r.key => return(r.entry)
          "failed"

        if Entry has SetCategory then
            latex(a : %) : String ==
                l : List Pair := entries a
                s : String := "\left["
                while not empty?(l) repeat
                    r : Pair := first l
                    l        := rest l
                    s := concat(s, concat(latex r.key, concat(" = ",
                            latex r.entry)$String)$String)$String
                    if not empty?(l) then s := concat(s, ", ")$String
                concat(s, " \right]")$String

--      assoc(k, l) ==
--        (r := find(#1.key=k, l)) case "failed" => "failed"
--        r

        assoc(k, t) ==
          for r in deref t repeat
            k = r.key => return r
          "failed"

        setelt!(t : %, k : Key, e : Entry) ==
          (r := assoc(k, t)) case Pair => (r::Pair).entry := e
          setref(t, concat([k, e], deref t))
          e

        remove!(k : Key, t : %) ==
          empty?(l := deref t) => "failed"
          k = first(l).key =>
            setref(t, rest l)
            first(l).entry
          prev := l
          curr := rest l
          while not empty? curr and first(curr).key ~= k repeat
            prev := curr
            curr := rest curr
          empty? curr => "failed"
          setrest!(prev, rest curr)
          first(curr).entry

--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.
