** -*- Mode:CafeOBJ -*-
** system: Chaos
** module: library
** file: rwl.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.
**
** -------------------------------------------------------------

**
** RWL
**
** allow using universal sorts
set sys universal-sort on

** we want to be very explicit here
set include BOOL off

sys:mod! RWL
      principal-sort Bool
{
  imports {
    protecting (BOOL)
    protecting (NAT-VALUE)
  }
  signature {
    -- [ Nat*, Nat < Nat* ]
    [ NzNat*, NzNat < NzNat* ]
    op * : -> NzNat* { constr }
    -- op + : -> Nat* { constr }
    -- op ! : -> Nat* { constr }
    pred _==>_ : *Cosmos* *Cosmos* { strat: (0) prec: 51 }

    ** NOTE: these two predicates are obsolate.
    -- _=(N:NzNat*)=>_ is equivalent to _=(1,N)=>*_
    -- pred _=(_)=>_ : *Cosmos* NzNat* *Cosmos* { strat: (0) prec: 51 }
    -- pred _=(_)=>_ suchThat _ : *Cosmos* NzNat* *Cosmos* Bool { strat: (0) prec: 51 }

    ** new search operators
    pred _=(_,_)=>*_ : *Cosmos* NzNat* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(_,_)=>+_ : *Cosmos* NzNat* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(_,_)=>!_ : *Cosmos* NzNat* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(_,_)=>*_ suchThat _: *Cosmos* NzNat* NzNat* *Cosmos* Bool
      { strat: (0) prec: 51 }
    pred _=(_,_)=>+_suchThat_: *Cosmos* NzNat* NzNat* *Cosmos* Bool
      { strat: (0) prec: 51 }
    pred _=(_,_)=>!_suchThat_: *Cosmos* NzNat* NzNat* *Cosmos* Bool
      { strat: (0) prec: 51 }
    ** experimental -------------
    pred _=(_,_)=>*_suchThat_{_} : *Cosmos* NzNat* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_,_)=>+_suchThat_{_} : *Cosmos* NzNat* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_,_)=>!_suchThat_{_} : *Cosmos* NzNat* NzNat* *Cosmos* Bool *Cosmos*
    ** -------------------------
    -- suchThat 'state equality predicate'
    pred _=(_,_)=>*_withStateEq_ : *Cosmos* NzNat* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_,_)=>+_withStateEq_ : *Cosmos* NzNat* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_,_)=>!_withStateEq_ : *Cosmos* NzNat* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_,_)=>*_suchThat_withStateEq_ : *Cosmos* NzNat* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_,_)=>+_suchThat_withStateEq_ : *Cosmos* NzNat* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
   pred _=(_,_)=>!_suchThat_withStateEq_ : *Cosmos* NzNat* NzNat* *Cosmos* Bool *Cosmos*
     { strat: (0) prec: 51 }

    ** the followings are handy version of =(,)=>* etc.
    -- 
    pred _==>*_ : *Cosmos* *Cosmos* { strat: (0) prec: 51 }
    pred _==>+_ : *Cosmos* *Cosmos* { strat: (0) prec: 51 }
    pred _==>!_ : *Cosmos* *Cosmos* { strat: (0) prec: 51 }
    pred _==>1_ : *Cosmos* *Cosmos* { strat: (0) prec: 51 }
    pred _==>*_withStateEq_ : *Cosmos* *Cosmos* *Cosmos* { strat: (0) prec: 51 }
    pred _==>+_withStateEq_ : *Cosmos* *Cosmos* *Cosmos* { strat: (0) prec: 51 }
    pred _==>!_withStateEq_ : *Cosmos* *Cosmos* *Cosmos* { strat: (0) prec: 51 }
    pred _==>1_withStateEq_ : *Cosmos* *Cosmos* *Cosmos* { strat: (0) prec: 51 }

    pred _==>1_suchThat_ : *Cosmos* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _==>*_suchThat_ : *Cosmos* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _==>+_suchThat_ : *Cosmos* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _==>!_suchThat_ : *Cosmos* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _==>1_suchThat_ withStateEq_ : *Cosmos* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _==>*_suchThat_withStateEq_ : *Cosmos* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _==>+_suchThat_withStateEq_ : *Cosmos* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _==>!_suchThat_withStateEq_ : *Cosmos* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }

    pred _=(_)=>*_ : *Cosmos* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(_)=>+_ : *Cosmos* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(_)=>!_ : *Cosmos* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(_)=>*_ withStateEq(_) : *Cosmos* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_)=>+_withStateEq(_) : *Cosmos* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_)=>!_withStateEq(_) : *Cosmos* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_)=>*_suchThat_ : *Cosmos* NzNat* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _=(_)=>+_suchThat_ : *Cosmos* NzNat* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _=(_)=>!_suchThat_ : *Cosmos* NzNat* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _=(_)=>*_suchThat_withStateEq_ : *Cosmos* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_)=>+_suchThat_withStateEq_ : *Cosmos* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(_)=>!_suchThat_withStateEq_ : *Cosmos* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }

    pred _=(,_)=>*_ : *Cosmos* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(,_)=>+_ : *Cosmos* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(,_)=>!_ : *Cosmos* NzNat* *Cosmos* { strat: (0) prec: 51 }
    pred _=(,_)=>*_withStateEq_ : *Cosmos* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(,_)=>+_withStateEq_ : *Cosmos* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(,_)=>!_withStateEq_ : *Cosmos* NzNat* *Cosmos* *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(,_)=>*_suchThat_ : *Cosmos* NzNat* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _=(,_)=>+_suchThat_: *Cosmos* NzNat* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _=(,_)=>!_suchThat_: *Cosmos* NzNat* *Cosmos* Bool { strat: (0) prec: 51 }
    pred _=(,_)=>*_suchThat_withStateEq_ : *Cosmos* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(,_)=>+_suchThat_withStateEq_ : *Cosmos* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }
    pred _=(,_)=>!_suchThat_withStateEq_ : *Cosmos* NzNat* *Cosmos* Bool *Cosmos*
      { strat: (0) prec: 51 }

    ** new experimental search predicate
    pred _=(_,_)=>+_if_suchThat_{_} : *Cosmos* NzNat* NzNat* *Cosmos* Bool Bool *Cosmos*
      { strat: (0) prec: 51 }

    ** _=>_ : 
    pred _=>_ : *Cosmos* *Cosmos* { strat: (0) prec: 51 }
  }
  axioms {
    var CXU : *Cosmos*
    var CYU : *Cosmos*
    var COND : Bool
    var MAX-R : NzNat*
    var MAX-D : NzNat*
    var PRED : *Cosmos*
    var BIND : *Cosmos*

    ** histrical builtin ==> is equivalent with =(1,*)=>*
    eq (CXU ==> CYU) = CXU =(1,*)=>* CYU .

    -- ==>
    eq (CXU ==>1 CYU) = (CXU =(1,*)=>+ CYU) .
    eq (CXU ==>* CYU) = (CXU =(*,*)=>* CYU) .
    eq (CXU ==>! CYU) = (CXU =(*,*)=>! CYU) .
    eq (CXU ==>+ CYU) = (CXU =(*,*)=>+ CYU) .
    eq (CXU ==>1 CYU suchThat COND) = (CXU =(1,*)=>+ CYU suchThat COND) .
    eq (CXU ==>* CYU suchThat COND) = (CXU =(*,*)=>* CYU suchThat COND) .
    eq (CXU ==>! CYU suchThat COND) = (CXU =(*,*)=>! CYU suchThat COND) .
    eq (CXU ==>+ CYU suchThat COND) = (CXU =(*,*)=>+ CYU suchThat COND) .
    eq (CXU ==>1 CYU withStateEq(PRED)) = (CXU =(1,*)=>+ CYU withStateEq(PRED)) .
    eq (CXU ==>* CYU withStateEq(PRED)) = (CXU =(*,*)=>* CYU withStateEq(PRED)) .
    eq (CXU ==>! CYU withStateEq(PRED)) = (CXU =(*,*)=>! CYU withStateEq(PRED)) .
    eq (CXU ==>+ CYU withStateEq(PRED)) = (CXU =(*,*)=>+ CYU withStateEq(PRED)) .
    eq (CXU ==>1 CYU suchThat COND withStateEq(PRED))
    = (CXU =(1,*)=>+ CYU suchThat COND withStateEq(PRED)) .
    eq (CXU ==>* CYU suchThat COND withStateEq(PRED))
    = (CXU =(*,*)=>* CYU suchThat COND withStateEq(PRED)) .
    eq (CXU ==>! CYU suchThat COND withStateEq(PRED))
    = (CXU =(*,*)=>! CYU suchThat COND withStateEq(PRED)) .
    eq (CXU ==>+ CYU suchThat COND withStateEq(PRED))
    = (CXU =(*,*)=>+ CYU suchThat COND withStateEq(PRED)) .

    -- =(NzNat*)=>
    eq (CXU =(MAX-R)=>* CYU) = (CXU =(MAX-R,*)=>* CYU) .
    eq (CXU =(MAX-R)=>! CYU) = (CXU =(MAX-R,*)=>! CYU) .
    eq (CXU =(MAX-R)=>+ CYU) = (CXU =(MAX-R,*)=>+ CYU) .
    eq (CXU =(MAX-R)=>* CYU suchThat COND) = (CXU =(MAX-R,*)=>* CYU suchThat COND) .
    eq (CXU =(MAX-R)=>! CYU suchThat COND) = (CXU =(MAX-R,*)=>! CYU suchThat COND) .
    eq (CXU =(MAX-R)=>+ CYU suchThat COND) = (CXU =(MAX-R,*)=>+ CYU suchThat COND) .
    eq (CXU =(MAX-R)=>* CYU withStateEq(PRED)) = (CXU =(MAX-R,*)=>* CYU withStateEq(PRED)) .
    eq (CXU =(MAX-R)=>! CYU withStateEq(PRED)) = (CXU =(MAX-R,*)=>! CYU withStateEq(PRED)) .
    eq (CXU =(MAX-R)=>+ CYU withStateEq(PRED)) = (CXU =(MAX-R,*)=>+ CYU withStateEq(PRED)) .
    eq (CXU =(MAX-R)=>* CYU suchThat COND withStateEq(PRED))
    = (CXU =(MAX-R,*)=>* CYU suchThat COND withStateEq(PRED)) .
    eq (CXU =(MAX-R)=>! CYU suchThat COND withStateEq(PRED))
    = (CXU =(MAX-R,*)=>! CYU suchThat COND withStateEq(PRED)) .
    eq (CXU =(MAX-R)=>+ CYU suchThat COND withStateEq(PRED))
    = (CXU =(MAX-R,*)=>+ CYU suchThat COND withStateEq(PRED)) .

    -- =(,NzNat*)=>
    eq (CXU =(,MAX-D)=>* CYU) = (CXU =(*,MAX-D)=>* CYU) .
    eq (CXU =(,MAX-D)=>! CYU) = (CXU =(*,MAX-D)=>! CYU) .
    eq (CXU =(,MAX-D)=>+ CYU) = (CXU =(*,MAX-D)=>+ CYU) .
    eq (CXU =(,MAX-D)=>* CYU suchThat COND)
      = (CXU =(*,MAX-D)=>* CYU suchThat COND) .
    eq (CXU =(,MAX-D)=>! CYU suchThat COND)
      = (CXU =(*,MAX-D)=>! CYU suchThat COND) .
    eq (CXU =(,MAX-D)=>+ CYU suchThat COND)
      = (CXU =(*,MAX-D)=>+ CYU suchThat COND) .
    eq (CXU =(,MAX-D)=>* CYU withStateEq(PRED))
      = (CXU =(*,MAX-D)=>* CYU withStateEq(PRED)) .
    eq (CXU =(,MAX-D)=>! CYU withStateEq(PRED))
      = (CXU =(*,MAX-D)=>! CYU withStateEq(PRED)) .
    eq (CXU =(,MAX-D)=>+ CYU withStateEq(PRED))
      = (CXU =(*,MAX-D)=>+ CYU withStateEq(PRED)) .
    eq (CXU =(,MAX-D)=>* CYU suchThat COND withStateEq(PRED))
      = (CXU =(*,MAX-D)=>* CYU suchThat COND withStateEq(PRED)) .
    eq (CXU =(,MAX-D)=>! CYU suchThat COND withStateEq(PRED))
      = (CXU =(*,MAX-D)=>! CYU suchThat COND withStateEq(PRED)) .
    eq (CXU =(,MAX-D)=>+ CYU suchThat COND withStateEq(PRED))
      = (CXU =(*,MAX-D)=>+ CYU suchThat COND withStateEq(PRED)) .

    -- =(NzNat*, NzNat*)=>
    eq (CXU =(MAX-R, MAX-D)=>* CYU) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :zero? t)) .
    eq (CXU =(MAX-R, MAX-D)=>! CYU) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :final? t)) .
    eq (CXU =(MAX-R, MAX-D)=>+ CYU) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D)) .
    eq (CXU =(MAX-R, MAX-D)=>* CYU suchThat COND) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :zero? t :cond cond)) .
    eq (CXU =(MAX-R, MAX-D)=>* CYU suchThat COND {BIND}) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :zero? t :cond cond :bind bind)) .
    eq (CXU =(MAX-R, MAX-D)=>! CYU suchThat COND) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :final? t :cond cond)) .
    eq (CXU =(MAX-R, MAX-D)=>! CYU suchThat COND {BIND}) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :final? t :cond cond :bind bind)) .
    eq (CXU =(MAX-R, MAX-D)=>+ CYU suchThat COND) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :cond cond)) .
    eq (CXU =(MAX-R, MAX-D)=>+ CYU suchThat COND {BIND}) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :cond cond :bind bind)) .

    -- =(NzNat*, NzNat*)=> withStateEq(BoolTerm/2)
    eq (CXU =(MAX-R, MAX-D)=>* CYU withStateEq(PRED)) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :zero? t :pred PRED)) .
    eq (CXU =(MAX-R, MAX-D)=>! CYU withStateEq(PRED)) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :final? t :pred PRED)) .
    eq (CXU =(MAX-R, MAX-D)=>+ CYU withStateEq(PRED)) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :pred PRED)) .
    eq (CXU =(MAX-R, MAX-D)=>* CYU suchThat COND withStateEq(PRED)) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :zero? t :cond cond :pred PRED)) .
    eq (CXU =(MAX-R, MAX-D)=>! CYU suchThat COND withStateEq(PRED)) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :final? t :cond cond :pred PRED)) .
    eq (CXU =(MAX-R, MAX-D)=>+ CYU suchThat COND withStateEq(PRED)) = 
      #!! (rwl-sch-set-result
	     (rwl-search :term cxu :pattern cyu :max-result MAX-R
		:max-depth MAX-D :cond cond :pred PRED)) .
    ** if
    eq (S:*Cosmos* =(MR:NzNat* ,MD:NzNat)=>+ SS:*Cosmos* if CC:Bool suchThat P:Bool { B:*Cosmos* }) =
      #!! (rwl-sch-set-result
	     (rwl-search :term S :pattern SS :max-result MR :max-depth MD :zero? nil
		:final? nil :cond P :if CC :bind B)) .
    ** =>
    -- eq (CXU => CYU) = #!! (rwl-sch-set-result (rwl-check-one-step-reachability CXU CYU)) .
       eq (CXU => CYU) = CXU =(1,*)=>* CYU .
  }
}

** setup 
lispq
(defun setup-rwl ()
  (setq *rwl-module* (eval-modexp "RWL"))
  (final-setup *rwl-module*)
  (with-in-module (*rwl-module*)
    (let* ((rwl-op-info (find-operator '("_" "=>" "_") 2 *rwl-module*))
	   (rwl-pred (and rwl-op-info (lowest-method* (car (opinfo-methods rwl-op-info))))))
      (unless rwl-pred
	(with-output-panic-message ()
	  (print "could not find _=>_")
	  (break)))
      (setq *rwl-predicate* rwl-pred))))

lispq
(setup-rwl)
-- lispq
-- (setup-tram-bool-modules)
lispq
(init-builtin-universal)
**
set sys universal-sort off
set include BOOL on
**
protect RWL
provide rwl
**
eof
