--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
-- Copyright (C) 2007-2010, Gabriel Dos Reis.
-- 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.

import Type
import ListAggregate
)abbrev domain LIST List
++ Author: Michael Monagan
++ Date Created: Sep 1987
++ Date Last Changed: September 9, 2011.
++ Basic Operations:
++   \#, append, concat, concat!, cons, construct, copy, elt, elt,
++   empty, empty?, eq?, first, member?, merge!, mergeSort, minIndex,
++   nil, null, parts, removeDuplicates!, rest, 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. this constructor provides some LISP-like functions
++   such as \spadfun{null} and \spadfun{cons}.
List(S:Type): Exports == Implementation where 
  Exports == ListAggregate S with
    nil             : %
      ++ \spad{nil} is the empty list.
    null            : %      -> Boolean
      ++ null(u) tests if list \spad{u} is the
      ++ empty list.
    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.
    if S has SetCategory 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.

  Implementation == add
    import %nil: %                           from Foreign Builtin
    import %peq: (%,%) -> Boolean            from Foreign Builtin
    import %pair: (S,%) -> %                 from Foreign Builtin
    import %lconcat: (%,%) -> %              from Foreign Builtin
    import %lempty?: % -> Boolean            from Foreign Builtin
    import %head: % -> S                     from Foreign Builtin
    import %tail: % -> %                     from Foreign Builtin
    import %lreverse: % -> %                 from Foreign Builtin
    import %lreverse!: % -> %                from Foreign Builtin
    import %llength: % -> NonNegativeInteger from Foreign Builtin
    import %icst0: NonNegativeInteger        from Foreign Builtin
    import %icst1: NonNegativeInteger        from Foreign Builtin
    import %idec: Integer -> Integer         from Foreign Builtin

    Qpush   ==> PUSH$Lisp
    cycleMax ==> 1000        -- value used in checking for cycles

    nil                == %nil
    null l             == %peq(l,%nil)
    cons(s, l)         == %pair(s,l)
    append(l:%, t:%)   == %lconcat(l,t)

    #x                 == %llength x
    concat(s:S,x:%)    == %pair(s,x)
    eq?(x,y)           == %peq(x,y)
    first x            == SPADfirst(x)$Lisp
    elt(x,"first")     == SPADfirst(x)$Lisp
    empty()            == %nil
    empty? x           == %lempty? x
    rest x             == %tail x
    elt(x,"rest")      == %tail x
    setfirst!(x,s)     ==
       empty? x => error "Cannot update an empty list"
       %store(%head x,s)$Foreign(Builtin)
       s
    setelt(x,"first",s) ==
       empty? x => error "Cannot update an empty list"
       %store(%head x,s)$Foreign(Builtin)
       s
    setrest!(x,y)      ==
       empty? x => error "Cannot update an empty list"
       %store(%tail x,y)$Foreign(Builtin)
       %tail x
    setelt(x,"rest",y)  ==
       empty? x => error "Cannot update an empty list"
       %store(%tail x,y)$Foreign(Builtin)
       %tail x
    construct l         == l pretend %
    parts s             == s pretend List S
    reverse! x         == %lreverse! x
    reverse x           == %lreverse x
    minIndex x          == 1

    rest(x, n) ==
       for i in %icst1..n repeat
          if empty? x then error "index out of range"
          x := %tail x
       x

    copy x ==
       y := empty()
       for i in %icst0.. while not empty? x repeat
          if i = cycleMax and cyclic? x then error "cyclic list"
          y := %pair(%head x,y)
          x := %tail x
       %lreverse! y

    if S has CoercibleTo(OutputForm) then
      coerce(x):OutputForm ==
         -- displays cycle with overbar over the cycle
         y := empty()$List(OutputForm)
         s := cycleEntry x
         while not %peq(x, s) repeat
           y := concat((first x)::OutputForm, y)
           x := rest x
         y := reverse! y
         empty? s => bracket y
         -- cyclic case: z is cylic part
         z := list((first x)::OutputForm)
         while not %peq(s, rest x) repeat
            x := rest x
            z := concat((first x)::OutputForm, z)
         bracket concat!(y, overbar commaSeparate reverse! z)

    if S has SetCategory then
      x = y ==
        %peq(x,y) => true
        while not empty? x and not empty? y repeat
           %head x ~=$S %head y => return false
           x := %tail x
           y := %tail y
        empty? x and empty? y

      latex(x : %): String ==
        s : String := "\left["
        while not empty? x repeat
          s := concat(s, latex(%head x)$S)$String
          x := %tail x
          if not empty? x then s := concat(s, ", ")$String
        concat(s, " \right]")$String

      member?(s,x) ==
         while not empty? x repeat
            if s = %head x then return true else x := %tail x
         false

    -- Lots of code from parts of AGGCAT, repeated here to
    -- get faster compilation
    concat!(x:%,y:%) ==
       empty? x => 
         empty? y => x
         Qpush(first y,x)
         %store(%tail x,rest y)$Foreign(Builtin)
         x
       z:=x
       while not empty? %tail z repeat
         z:=%tail z
       %store(%tail z,y)$Foreign(Builtin)
       x

    -- Then a quicky:
    if S has SetCategory then
      removeDuplicates! l ==
        p := l
        while not empty? p repeat
 --       p := setrest!(p, remove!(#1 = %head p, %tail p))
 -- far too expensive - builds closures etc.
          pp:=p
          f:S:=%head p
          p:=%tail p
          while not empty? (pr:=%tail pp) repeat
            if (%head pr)@S = f then
              %store(%tail pp,%tail pr)$Foreign(Builtin)
            else pp:=pr
        l

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

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

    merge!(f, p, q) ==
      empty? p => q
      empty? q => p
      r,t: %
      %peq(p, q) => error "cannot merge a list into itself"
      if f(%head p, %head q)
        then (r := t := p; p := %tail p)
        else (r := t := q; q := %tail q)
      while not empty? p and not empty? q repeat
        if f(%head p, %head q)
          then (%store(%tail t, p)$Foreign(Builtin); t := p; p := %tail p)
          else (%store(%tail t, q)$Foreign(Builtin); t := q; q := %tail q)
      %store(%tail t, if empty? p then q else p)$Foreign(Builtin)
      r

    split!(p, n) ==
       n < %icst1 => error "index out of range"
       p := rest(p, %idec(n)::NonNegativeInteger)
       q := %tail p
       %store(%tail p,%nil)$Foreign(Builtin)
       q

    mergeSort(f, p, n) ==
      if n = 2 and f(first rest p, first p) then p := reverse! 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)

    if S has SetCategory 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
        lu:% := empty()
        while not empty? l1 repeat
          l11:=l1.1
          if not member?(l11,l2) then lu := concat(l11,lu)
          l1 := rest l1
        lu

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

import Type
import FiniteLinearAggregateFunctions2
)abbrev package LIST2 ListFunctions2
++ Author:
++ Date Created:
++ Change History:
++ 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

import Type
import Type
)abbrev package LIST3 ListFunctions3
++ Author:
++ Date Created:
++ Change History:
++ 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,list1, 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/4,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 ==
      empty?(la) or empty?(lb) => empty()$LC
      concat(fn(first la, first lb), map(fn, rest la, rest lb))

import Type
import SetCategory
import List
)abbrev package LIST2MAP ListToMap
++ Author: Manuel Bronstein
++ Date Created: 22 Mar 1988
++ Change History:
++   11 Oct 1989   MB   ?
++ 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 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 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 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 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 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 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)             == match(la, lb, #1)
    match(la:LA, lb:LB, a:A)  == lb.position(a, la)
    match(la:LA, lb:LB, b:B)  == match(la, lb, #1, b)
    match(la:LA, lb:LB, f:AB) == match(la, lb, #1, 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

import SetCategory
import List
import Reference
)abbrev domain ALIST AssociationList
++ Author:
++ Date Created:
++ Change History:
++ 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:SetCategory):
 AssociationListAggregate(Key, Entry) == add
        Pair ==> Record(key:Key, entry:Entry)
        Rep := Reference 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"

        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

