-- file: stringOfString.mod

--> Srting of String of elements
--> some sophisticated parameterized modules

--> a loose specification of totally ordered elements
mod* TOSET 
{ us(EQL)
  [ Elt ]
  pred _<_ : Elt Elt  -- strict total ordering

  vars E1 E2 E3 : Elt
  eq E1 < E1 = false .
  eq ( ((E1 < E2) or (E2 < E1) or (E1 = E2)) 
        and
       not((E1 < E2) and (E2 < E1))
        and
       not((E2 < E1) and (E1 = E2)) 
        and
       not((E1 < E2) and (E1 = E2)) ) = true .
  eq (((E1 < E2) and (E2 < E3)) implies (E1 < E3)) = true .
}

mod! STRGlex (Y :: TOSET) {
  [ Elt < Strg ]
  op (_ _) : Strg Strg -> Strg {assoc}

  -- lexicographic ordering over strings
  op _<<_ : Strg Strg -> Bool
  eq (E1:Elt):Strg << (E2:Elt):Strg = (E1):Elt < (E2):Elt .

  ceq (E1:Elt):Strg << (E2:Elt  S2:Strg) = true 
                  if (E1 = E2) .
  ceq (E1:Elt):Strg << (E2:Elt  S2:Strg) = true 
                  if (E1 < E2).
  ceq (E1:Elt):Strg << (E2:Elt  S2:Strg) = false 
                  if (E2 < E1) .

  ceq (E1:Elt  S1:Strg) << (E2:Elt):Strg  = false 
                  if (E1 = E2) .
  ceq (E1:Elt  S1:Strg) << (E2:Elt):Strg  = true
                  if (E1 < E2) .
  ceq (E1:Elt  S1:Strg) << (E2:Elt):Strg  = false 
                  if (E2 < E1) .

  ceq (E1:Elt  S1:Strg) << (E2:Elt  S2:Strg) = S1 << S2 
		if E1 = E2 .
  ceq (E1:Elt  S1:Strg) << (E2:Elt  S2:Strg) = true 
                if (E1 < E2) .
  ceq (E1:Elt  S1:Strg) << (E2:Elt  S2:Strg) = false 
                if (E2 < E1) .
}

mod! NATeq {pr(NAT + EQL)}

view natAsToset from TOSET to NATeq {
  sort Elt -> Nat,
  op (E1:Elt < E2:Elt) -> (E1:Nat < E2:Nat)
}

--> the correct way for instantiation
make NAT-STRGlex1 (STRGlex(Y <= natAsToset))
make NAT-STRGlex2 (STRGlex(natAsToset))

--> the following on the fly instantiation is also possible
--> this style is recommended 
make NAT-STRGlex3
  (STRGlex(NATeq{sort Elt -> Nat,
                op (E1:Elt < E2:Elt) -> (E1:Nat < E2:Nat)}))
make NAT-STRGlex4
  (STRGlex(Y <= view to NATeq
               {sort Elt -> Nat,
                op (E1:Elt < E2:Elt) -> (E1:Nat < E2:Nat)}))

--> this is also working because the same name is use 
--> for the less than operator, and
--> op (E1:Elt < E2:Elt) -> (E1:Nat < E2:Nat)
--> can be inferred automatically;
--> this is the default view mechanism
make NAT-STRGlex5
    (STRGlex(NATeq{sort Elt -> Nat}))

--> test for NAT-STRGlex4
open NAT-STRGlex4
red (1 2 3) << 4 .
red (1 2 3) << (1 2 1) .
close

--> defining string of string of naturals
--> this contains serious problems because 
--> the sort name of Strg has two meanings and
--> the operator name of (_ _) has two meanings
make NAT-STRG-STRGlex1
  (STRGlex(STRGlex(NATeq {sort Elt -> Nat})
         {sort Elt -> Strg,
          op (E1:Elt < E2:Elt) -> (E1:Strg << E2:Strg)}))

--> test
open NAT-STRG-STRGlex1
parse ((1 2) (3 2)) .
red ((1 2) (3 2)) .

parse ((1 2) << (3 2)) .
-- red ((1 2) << (3 2)) .  -- stack overflow!!

close

make NAT-STRG-STRGlex2
(
 STRGlex
 ( ((STRGlex
     (NATeq{sort Elt -> Nat}))
    *{sort Strg -> St,
      op (_ _) -> (_&_),
      op (_<<_) -> (_<st_)})
   {sort Elt -> St,
    op (E1:Elt < E2:Elt)
       ->(E1:St <st E2:St)} )
)

--> test
open NAT-STRG-STRGlex2
parse (1 & 2 & (2 & 3)) .
red (1 & 2 & (2 & 3)) .
parse ((1 & 2) (2 & 3)) .
red ((1 & 2) (2 & 3)) .
red ((1 & 2) (2 & 3)) .

red 3 < 5 .

red ((1 & 2) <st ((1 & 2) & (2 & 3))) .

red ((1 & 2) << ((1 & 2)  (2 & 3))) .

red ((1 & 2) << ((1 & 1)  (2 & 3))) .

red (((1 & 2) (2 & 3)) << ((1 & 2)  (2 & 3)  3)) .

red (((1 & 2)  (2 & 3)) << ((1 & 2)  (2 & 1)  3)) .

close

-- the following module uses the (_ _) operator for 
-- representing two concatenation in two levels
-- and (_ _) operator can only represent the lower level
-- cancatenation!
make NAT-STRG-STRGlex3
  (STRGlex((STRGlex(NATeq {sort Elt -> Nat})
          * {sort Strg -> St,
             op (_<<_) -> (_<st_)})
         {sort Elt -> St,
          op (E1:Elt < E2:Elt) -> (E1:St <st E2:St)}))

open NAT-STRG-STRGlex3
parse (1 2):St .
parse (1 2 (2  3)):St .
red (1 2 (2  3)):St .

parse ((1 2):St (2  3):St):Strg .

parse (1 2):St << (2  3):St .
red (1 2):St << (2  3):St .

parse (1 2 (2  3)):Strg .

parse (1 2) <st (2  3) .
red (1 2) <st (2  3) .

parse ((1 2):St (2  3):St):Strg .
red (1 2) <st (2  3) .

close


eof