;--------------------------------------------------------------------
; RSC-REPOSITORY                                               RET/97
;--------------------------------------------------------------------
;                    Copyright@1997 by F. Luis Neves
;
; Author(s):         FLN (F. Luis Neves)
; Revisions:         25.Fev.97 Rev: 24 Mar, 1997
;                              Rev: 18 Jun, 1997 (xDMatch,xMetaMatch)
;                              Rev:  1 Dec, 1997 (Abs/Rep Functions)
;                              Rev:  3 Dec, 1997 (Final revisions)
;                              Rev: 25 Jan, 1998 (X = V | X-list)
;
;--------------------------------------------------------------------
;
; Comments: REwrite system Tool
; 
; (a) Filiation: RET < EXPT
; (b) Interface:
;                        -----------
;                       |           |
;           CON(B) ---> |           | <--- RST(X)
;                       |           |
;           VAR(A) ---> |    RET    | <--- LST(X)
;                       |           |
;          PUSH(B) ---> |           | POP(P):B --->
;                       |           |
;                        -----------
;
; (c) State: S = X; X = C + V + O x X^2
; (c) State: S = X; X = V + O x X-list
; (d) Model:
;
;--------------------------------------------------------------------
;

TYPE

S = X;
;C = INT;
V = SYM;
F = STR;
;X = C | V | F | O;
X = V | F | O;
;O = OX:STR LX:X RX:X;
O = OX:STR AX:X-list;

ENDTYPE

;--------------------------------------------------------------------
; Auxiliary functions

LX(o) = p1(AX(o));
RX(o) = p2(AX(o));
isC(x) = is-O(x) && AX(x) == <>;

;
; x/y (x,y reals and result x 100)
;
pdiv(x,y) = x .* div(100,y);


;
; Number of variables
;
FUNC xVar(x:X):INT
RETURN if (isC(x) -> 0,
           is-V(x) -> 1,
           is-O(x) -> intSUM(< xVar(a) | a <- AX(x) >))
       otherwise (0);

;
; Number of constants
;
FUNC xCon(x:X):INT
RETURN if (isC(x) -> 1,
           is-V(x) -> 0,
           is-O(x) -> intSUM(< xCon(a) | a <- AX(x) >))
       otherwise (0);

;
; Number of operators 
;
FUNC xOpr(x:X):INT
RETURN if (isC(x) -> 0,
           is-V(x) -> 0,
           is-O(x) -> 1 .+ intSUM(< xOpr(a) | a <- AX(x) >))
       otherwise (0);

;
; Number of meta-symbols ('_xx_,'_er_,'_ff_,...) 
;
FUNC xMetaSym(x:X):INT
RETURN if (x == '_xx_ -> 1,
           x == '_er_ -> 1,
           x == '_ff_ -> 1,
           x == '_fd_ -> 1,
;           isC(x) -> 0,
;           is-V(x) -> 0,
           is-O(x) -> intSUM(< xMetaSym(a) | a <- AX(x) >))
       otherwise (0);

;
; Expression complexity
;
FUNC xComplex(x:X):INT
RETURN if (is-V(x) -> 1,
           isC(x) -> 1,
           is-O(x) -> 1 .+ intSUM(< xComplex(a) | a <- AX(x) >))
       otherwise (100);

;
; Expression print
;
FUNC xPrint(x:X):Void
RETURN if (isC(x) -> princ(OX(x)),
           is-V(x) -> princ(x),
           is-O(x) -> let (o = OX(x), a = AX(x))
                      in do(princ(o,"("),
                            foreach(a,AX(x),xPrint(a)),
                            princ(")")));

;
; Expression string
;
FUNC xString(x:X):STR-list
RETURN if (isC(x) -> <OX(x)>,
           is-V(x) -> <symstr(x)>,
           is-F(x) -> <x>,
           is-O(x) -> let (o = OX(x),
                           a = AX(x))
                      in xInfix(o,a))
       otherwise (<>);

FUNC xInfix(o:STR,a:X-list):STR-list
RETURN if (a == <>) then <>
       else let (h = hd(a), t = tl(a))
            in if (t == <>) then <o,"(">^xString(h)^<")">
               else <"(">^xString(h)^CONC(<<o>^xString(x) | x <- t>)^<")">;

;
; Expression TeX string
;
FUNC xTeX(x:X):STR-list
RETURN if (isC(x) -> <OX(x)>,
           is-V(x) -> <symstr(x)>,
           is-F(x) -> <x>,
           is-O(x) -> let (o = OX(x),
                           a = AX(x))
                      in xTeXInfix(o,a))
       otherwise (<>);

FUNC xTeXInfix(o:STR,a:X-list):STR-list
RETURN if (a == <>) then <>
       else let (h = hd(a), t = tl(a),
                 s = if (o == "*" -> " \\times ",
                         o == "^" -> "^",
                         o == "+" -> " + ",
                         o == "->" -> " \\hookrightarrow "))
            in if (t == <>) then <s,"{(">^xTeX(h)^<")}">
               else <"{(">^xTeX(h)^CONC(<<s>^xTeX(x) | x <- t>)^<")}">;

;
; Expression subterms which does not match a given template x2
;
FUNC xNotMatch(x1,x2:X):INT
RETURN if (isC(x2) -> if isC(x1) then 1 else 0,
           is-V(x2) -> if is-V(x1) then 1 else 0,
           is-O(x2) -> if is-O(x1)
                       then if xMatch(x1,x2)
                            then intSUM(< xNotMatch(a,x2) | a <- AX(x1) >)
                            else 1 .+ intSUM(< xNotMatch(a,x2) | a <- AX(x1) >)
                       else 0)
       otherwise (0);

;
; Expression match - x2 is the template
;
FUNC xMatch(x1,x2:X):BOOL
RETURN if (isC(x1) && isC(x2) -> x1 == x2,
           is-V(x2)             -> true,
           is-F(x1)             -> true,
           is-O(x1) && is-O(x2) -> let (o1 = OX(x1), o2 = OX(x2),
                                        a1 = AX(x1), a2 = AX(x2))
                                   in (o1 == o2) && _xMatch_(a1,a2))
       otherwise (false);

_xMatch_(a1,a2) =
    if (a1 == <> && a2 == <> -> true,
        a1 != <> && a2 == <> -> false,
        a1 == <> && a2 != <> -> false)
    otherwise (let (h1 = hd(a1), h2 = hd(a2),
                    t1 = tl(a1), t2 = tl(a2))
               in xMatch(h1,h2) && _xMatch_(t1,t2));

;
; Expression first match (is there any match?) - x2 is the template
;
FUNC xFirstMatch(x1,x2:X):BOOL
RETURN if xMatch(x1,x2) then true
       else if is-O(x1)
            then ||-orio(false,< xFirstMatch(x,x2) | x <- AX(x1) >)
            else false;

;
; Expression near match
;
FUNC xNearMatch(x1,x2:X):INT
RETURN if (xMatch(x1,x2) -> 100,
           _xNearMatch1_(x1,x2,33,39) -> 50,
           _xNearMatch1_(x2,x1,33,39) -> 50)
;           _xNearMatch2_(x1,x2,39) -> 25)
       otherwise (0);

_xNearMatch1_(x1,x2,i,j) =
  if (i > j) then false
  else if xMatch(FirstMatch(x1,i),x2) then true
       else _xNearMatch1_(x1,x2,i.+1,j);

;
; pouco eficiente...
;
_xNearMatch2_(x1,x2,k) =
  let (m = { xMatch(FirstMatch(x0,i),FirstMatch(x2,j)) | i <- inseg(k),
                                                         j <- inseg(k) })
  in if 'true in m then true else false;

;
; If xFirstMatch replaces the expression match with '_xx_
; x2 is the template
;
FUNC xMetaMatch(x1,x2:X):X
RETURN
  if xMatch(x1,x2) then '_xx_
  else if is-O(x1)
       then let (o = OX(x1), a = AX(x1))
            in O(o,_xMetaMatch_(a,x2))
       else x1;
;       then if (LX(x1) == '_xx_ -> O(OX(x1),<'_xx_,xMetaMatch(RX(x1),x2)>),
;                RX(x1) == '_xx_ -> O(OX(x1),<xMetaMatch(RX(x1),x2),'_xx_>),
;                xMetaMatch(LX(x1),x2) == '_xx_ -> O(OX(x1),<'_xx_,RX(x1)>),
;                xMetaMatch(RX(x1),x2) == '_xx_ -> O(OX(x1),<LX(x1),'_xx_>))
;            otherwise (O(OX(x1),<xMetaMatch(LX(x1),x2),xMetaMatch(RX(x1),x2)>))
;       else x1;

_xMetaMatch_(a1,x2) =
    if (a1 == <>) then <>
    else let (h = hd(a1), t = tl(a1))
         in if h == '_xx_ then cons(h,_xMetaMatch_(t,x2))
            else cons(xMetaMatch(h,x2),_xMetaMatch_(t,x2));

;
; Degree of match
;
FUNC xDegreeMatch(x1,x2:X):INT
RETURN
  if (xMatch(x1,x2)      -> 100,
      xFirstMatch(x1,x2) -> div(100,xComplex(xMetaMatch(x1,x2))))
  otherwise (0);


;--------------------------------------------------------------------
;
; Rewrite functions
;
;--------------------------------------------------------------------
;
;
; Root Match: applies the rule (if possible) to the root only
;
FUNC RootMatch(x:X,i:INT):X
RETURN if (i == 0 -> RR0(x),
           i == 1 -> RR1(x),
           i == 2 -> RR2(x),
           i == 3 -> RR3(x),
           i == 4 -> RR4(x),
           i == 5 -> RR5(x),
           i == 6 -> RR6(x),
           i == 7 -> RR7(x),
           i == 8 -> RR8(x),
           i == 9 -> RR9(x),
           i == 10 -> RR10(x),
           i == 11 -> RR11(x),
           i == 12 -> RR12(x),
           i == 13 -> RR13(x),
           i == 14 -> RR14(x),
           i == 15 -> RR15(x),
           i == 16 -> RR16(x),
           i == 17 -> RR17(x),
           i == 18 -> RR18(x),
           i == 19 -> RR19(x),
           i == 20 -> RR20(x),
           i == 21 -> RR21(x),
           i == 22 -> RR22(x),
           i == 23 -> RR23(x),
           i == 24 -> RR24(x),
           i == 25 -> RR25(x),
           i == 26 -> RR26(x),
           i == 27 -> RR27(x),
           i == 28 -> RR28(x),
           i == 29 -> RR29(x),
           i == 30 -> RR30(x),
           i == 31 -> RR31(x),
           i == 32 -> RR32(x),
; Inequacional
           i == 33 -> RR33(x),
           i == 34 -> RR34(x),
           i == 35 -> RR35(x),
           i == 36 -> RR36(x),
           i == 37 -> RR37(x),
           i == 38 -> RR38(x),
           i == 39 -> RR39(x));

;
; First Match: applies the rule (if possible) to the first expression match
;
FUNC FirstMatch(x:X,i:INT):X
RETURN if (isC(x) || is-V(x)) then RootMatch(x,i)
       else let (x1 = RootMatch(x,i))
            in if (x != x1) then x1
               else let (o = OX(x), a = AX(x))
                    in O(o,_FirstMatch_(a,i));

_FirstMatch_(a,i) =
    if (a == <>) then <>
    else let (h = hd(a), t = tl(a), r = FirstMatch(h,i))
         in if (h != r) then cons(r,t) else cons(h,_FirstMatch_(t,i));

;
; Applies a list of Root Match rules
;
FUNC ApplyRootMatch(x:X,l:INT-list):X
RETURN if (l == <>) then x
       else let (h = head(l), t = tail(l), r = RootMatch(x,h))
            in ApplyRootMatch(r,t);

;
; Applies a list of FirstMatch rules
;
FUNC ApplyFirstMatch(x:X,l:INT-list):X
RETURN if (l == <>) then x
       else let (h = head(l), t = tail(l), r = FirstMatch(x,h))
            in ApplyFirstMatch(r,t);