** -*- Mode:CafeOBJ -*-
** system: Chaos
** module: library
** file: eql.mod
**
** Copyright (c) 2000-2015, Toshimi Sawada. 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.
**
** THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
** 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 AUTHOR 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.
**
** -------------------------------------------------------------

require truth

-- system internal flag : on -> allow using universal sorts.
--          Cosmos
--           /   \
--      Universal HUniveral

set sys universal-sort on

-- we don't want to include BOOL
lispq
(progn 
  (setq *include-bool-save* *include-bool*)
  (setq *include-bool* nil))

sys:mod! EQL {
  protecting (TRUTH)
  pred _=_ : *Cosmos* *Cosmos* { comm strat:(1 2 0) prec: 51 }
  eq (CUX:*Cosmos* = CUX) = true .
  ceq [:nonexec]: CUX:*Cosmos* = CUY:*Cosmos* if (CUX = CUY) .
**  ceq (CUX:*Cosmos* = CUY:*Cosmos*) = #!! (coerce-to-bool (!term-eq CUX CUY))
**      if (term-type(CUX) == :literal) .
  eq (true = false) = false .
}

lispq
(defun setup-eql ()
  (setq *eql-module* (eval-modexp "EQL"))
  (prepare-for-parsing *eql-module*)
  (with-in-module (*eql-module*)
    (let* ((eq-op (find-operator '("_" "=" "_") 2 *eql-module*))
	   (eq-meth (lowest-method* (car (opinfo-methods eq-op)))))
      (setq *eql-op* eq-meth))))

lispq
(setup-eql)

set sys universal-sort off
lispq
(setq *include-bool* *include-bool-save*)
**
protect EQL
provide eql
**
eof
** EOF
