1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
2-- All rights reserved.
3--
4-- Redistribution and use in source and binary forms, with or without
5-- modification, are permitted provided that the following conditions are
6-- met:
7--
8--     - Redistributions of source code must retain the above copyright
9--       notice, this list of conditions and the following disclaimer.
10--
11--     - Redistributions in binary form must reproduce the above copyright
12--       notice, this list of conditions and the following disclaimer in
13--       the documentation and/or other materials provided with the
14--       distribution.
15--
16--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
17--       names of its contributors may be used to endorse or promote products
18--       derived from this software without specific prior written permission.
19--
20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31
32)package "BOOT"
33
34-- This one is not currently in general use, but can be applied
35-- to various situations are required
36
37minimalise x ==
38  $hash : local := MAKE_HASHTABLE('UEQUAL)
39  min x where
40    min x ==
41      y:=HGET($hash,x)
42      y => y
43      PAIRP x =>
44        x = '(QUOTE T) => '(QUOTE T)
45        -- copes with a particular Lucid-ism, God knows why
46        -- This circular way of doing things is an attempt to deal with Lucid
47        -- Who may place quoted cells in read-only memory
48        z := min first x
49        if not EQ(z, first x) then RPLACA(x, z)
50        z:=min CDR x
51        if not EQ(z,CDR x) then RPLACD(x,z)
52        HashCheck x
53      REFVECP x =>
54        for i in 0..MAXINDEX x repeat
55          x.i:=min (x.i)
56        HashCheck x
57      STRINGP x => HashCheck x
58      x
59    HashCheck x ==
60      y:=HGET($hash,x)
61      y => y
62      HPUT($hash,x,x)
63      x
64  x
65