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