-- Copyright (C) 2007-2008 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.
--

-- This file defines some utility functions common to both the compiler
-- and interpreter.

import '"vmlisp"
)package "BOOT"

++ returns true if `f' is bound to a macro.
macrop: %Thing -> %Boolean
macrop f ==
  IDENTP f and MACRO_-FUNCTION f

++ returns true if `f' is bound to a function
functionp: %Thing -> %Boolean
functionp f ==
  IDENTP f => FBOUNDP f and not MACRO_-FUNCTION f
  FUNCTIONP f

++ remove `item' from `sequence'.
delete: (%Thing,%Sequence) -> %Sequence
delete(item,sequence) ==
  SYMBOLP item => 
    REMOVE(item,sequence,KEYWORD::TEST,function EQ)
  atom item and not ARRAYP item =>
    REMOVE(item,SEQUENCE)
  REMOVE(item,sequence,KEYWORD::TEST,function EQUALP)

++ returns true if `x' is contained in `y'.
CONTAINED: (%Thing,%Thing) -> %Boolean
CONTAINED(x,y) == main where
  main() ==
    SYMBOLP x => eq(x,y)
    equal(x,y)
  eq(x,y) ==
    atom y => EQ(x,y)
    eq(x, car y) or eq(x, cdr y)
  equal(x,y) ==
    atom y => EQUAL(x,y)
    equal(x, car y) or equal(x, cdr y)

++ Returns all the keys of association list `x'
-- ??? Should not this be named `alistAllKeys'?
ASSOCLEFT: %Thing -> %Thing
ASSOCLEFT x ==
  atom x => x
  MAPCAR(function first,x)

++ Returns all the datums of association list `x'.
-- ??? Should not this be named `alistAllValues'?
ASSOCRIGHT: %Thing -> %Thing
ASSOCRIGHT x ==
  atom x => x
  MAPCAR(function rest,x)

++ Put the association list pair `(x . y)' into `l', erasing any 
++ previous association for `x'.
ADDASSOC: (%Thing,%Thing,%List) -> %List
ADDASSOC(x,y,l) ==
  atom l => [[x,:y],:l]
  x = first first l => [[x,:y],:cdr l]
  [first l,:ADDASSOC(x,y,rest l)]


++ Remove any assocation pair `(u . x)' from list `v'.
DELLASOS: (%Thing,%List) -> %List
DELLASOS(u,v) ==
  atom v => nil
  u = first first v => rest v
  [first v,:DELLASOS(u,rest v)]


++ Return the datum associated with key `x' in association list `y'.
-- ??? Should not this be named `alistValue'?
LASSOC: (%Thing,%List) -> %Thing
LASSOC(x,y) ==
  atom y => nil
  x = first first y => rest first y
  LASSOC(x,rest y)

++ Return the key associated with datum `x' in association list `y'.
rassoc: (%Thing,%List) -> %Thing
rassoc(x,y) ==
  atom y => nil
  x = rest first y => first first y
  rassoc(x,rest y)