in Stack

***
*** obj MAIN is comparable to a class or module declaration.

obj MAIN is

    *** The protecting clause in OBJ is like importing.
    protecting STACK .
    protecting INT .

    *** An OBJ op primarily declares functions, such as main here.
    op main : -> Stack .

    *** An OBJ parameterlesss op decl can also be used to declare a single-
    *** assignment variable of a particular type
    op s1 : -> Stack .
    op s2 : -> Stack .
    op i : -> Int .

    *** OBJ equations declare what the program does.  Typically, they're used
    *** as in object STACK to define behavior of ADT operations.  They can also
    *** be used as below to simulate a form of single assignment programming.
    *** E.g., the immediately following four equations simulate the following
    *** ML-style let block:
    ***

    eq s1 = pop(push(push(push(emptyStack, 1), 2), 3)) .
    eq i = top(push(push(push(emptyStack, 1), 2), 3)) + 1 .
    eq s2 = push(push(s1, i), 5) .

    eq main = pop(s2) .

endo

*** The following executes program main
reduce main .

*** The result of execution is the stack push(push(push(emptyStack,1),2),4).

obj LIST is sort List .
   protecting INT .

   op car : List -> Int .
   op cdr : List -> List .
   op cons : Int List -> List .
   op append : List List -> List .
   op emptyList : -> List .

   var e : Int .
   var l l1 l2 : List .

   eq car(cons(e,l)) = e .
   eq cdr(cons(e,l)) = l .
   eq car(append(l1,l2)) = car(l1) .
   eq cdr(append(l1,l2)) = append(cdr(l1),l2) .
   eq append(emptyList,l) = l .
   eq append(l,emptyList) = l .
endo

th ELEM is sort Elem .
endth

view ELEM-TO-NAT from ELEM to NAT is
    sort Elem to Nat .
endv

obj SET[EL :: ELEM] is sort Set .

    op insert : Set Elem -> Set .
    op delete : Set Elem -> Set .
    op find : Set Elem -> Bool .
    op emptyset : -> Set .
    op equal : Set Set -> Bool .

    var S S' : Set .
    var E E' : Elem .

    eq find(emptyset, E) = false .
    eq find(insert(S, E), E') =
        if E == E' then true else find(S, E') fi .
    eq delete(emptyset, E) = emptyset .
    eq delete(insert(S, E), E') =
        if E == E'
        then delete(S, E')
        else insert(delete(S, E'), E)
        fi .
    eq equal(emptyset, emptyset) = true .
    eq equal(emptyset, insert(S, E)) = false .
    eq equal(insert(S, E), emptyset) = false .
    eq equal(S, insert(S', E)) =
        if find(S, E)
        then equal(delete(S, E), delete(S', E))
        else false
        fi .
endo

in List-Int

obj BinSearchTree is sort BST .
  protecting LIST + INT .

  op makeTree : Int BST BST -> BST .
  op root : BST -> Int .
  op find : BST Int -> BST .
  op del : BST Int -> BST .
  op reinsert : BST BST -> BST .
  op enum : BST -> List .
  op emptyTree : -> BST .
  op legalBST : BST -> Bool .   *** Optional (see below)
  op insert : BST Int -> BST .  *** Optional (ibid.)

  var b b1 b2 : BST .
  var e e1 e2 : Int .

  eq root(makeTree(e, b1, b2)) = e .

  eq find(emptyTree,e) = emptyTree .
  eq find(makeTree(e1,b1,b2),e2) =
    if legalBST(makeTree(e1,b1,b2))
    then if e1 == e2 then makeTree(e1,b1,b2)
         else if e2 < e1 then find(b1,e2)
              else find(b2,e2) fi fi
    else
      emptyTree
    fi .

  eq del(emptyTree,e) = emptyTree .
  eq del(makeTree(e1,b1,b2),e2) =
    if e1 == e2 then reinsert(b1,b2)
    else if e2 < e1 then makeTree(e1,del(b1,e2),b2)
         else makeTree(e1,b1,del(b2,e2)) fi
    fi .

  eq reinsert(b,makeTree(e,b1,b2)) =
    if b1 == emptyTree
    then makeTree(e,b,b2) else makeTree(e,reinsert(b,b1),b2) fi .
  eq reinsert(b,emptyTree) = b .
  eq reinsert(emptyTree,b) = b .

  eq enum(makeTree(e,b1,b2)) = append(enum(b1), cons(e, enum(b2))) .
  eq enum(emptyTree) = emptyList .


  *** ALTERNATIVES FOR OPTIONAL WELL-FORMEDNESS CHECKING
  *** Eqns for legalBST could be expanded to check search tree well-formedness.
  eq legalBST(makeTree(e,b1,b2)) = true .

  *** Alternatively, eqns for an insert op could enforce well-formedness:
  eq insert(emptyTree,e) = makeTree(e,emptyTree,emptyTree) .
  eq insert(makeTree(e1,b1,b2),e2) =
    if e1 == e2 then makeTree(e1,b1,b2)
    else
      if e2 < e1
      then makeTree(e1,insert(b1,e2),b2)
      else makeTree(e1,b1,insert(b2,e2))
      fi
    fi .

endo


*** Instantiate a BinSearchTree object
make BST-INT is BinSearchTree endm


*** Do some sample reductions
reduce del(
  makeTree(5,
    makeTree(2,
      makeTree(1,emptyTree,emptyTree),
        makeTree(3,emptyTree,emptyTree)),
    makeTree(10,
      makeTree(6,emptyTree,emptyTree),
      makeTree(12,emptyTree,emptyTree))),
  5) .
*** Result is:
*** makeTree(10,
***   makeTree(6,
***     makeTree(2,
***       makeTree(1,emptyTree,emptyTree),
***       makeTree(3,emptyTree,emptyTree)),
***     emptyTree),
***   makeTree(12,emptyTree,emptyTree))


reduce enum(
  makeTree(5,
    makeTree(2,
         makeTree(1,emptyTree,emptyTree),
         makeTree(3,emptyTree,emptyTree)),
    makeTree(10,
         makeTree(6,emptyTree,emptyTree),
         makeTree(12,emptyTree,emptyTree)))
  ) .
*** Result is:
*** append(append(cons(1,emptyList),cons(2,cons(3,emptyList))),
***    cons(5,append(cons(6,emptyList),cons(10,cons(12,emptyList)))))


reduce car(cdr(cdr(
 enum(
  makeTree(5,
    makeTree(2,
         makeTree(1,emptyTree,emptyTree),
         makeTree(3,emptyTree,emptyTree)),
    makeTree(10,
         makeTree(6,emptyTree,emptyTree),
         makeTree(12,emptyTree,emptyTree)))
  )))) .
*** Result is: 3

th ELEM is sort Elem .
endth

view ELEM-TO-NAT from ELEM to NAT is
    sort Elem to Nat .
endv

obj LIST[E :: ELEM] is sort List .
   op car : List -> Elem .
   op cdr : List -> List .
   op cons : Elem List -> List .
   op append : List List -> List .
   op emptyList : -> List .

   var e : Elem .
   var l l1 l2 : List .

   eq car(cons(e,l)) = e .
   eq cdr(cons(e,l)) = l .
   eq car(append(l1,l2)) = car(l1) .
   eq cdr(append(l1,l2)) = append(cdr(l1),l2) .
endo

make LIST-NAT is LIST[ELEM-TO-NAT] endm

make LIST-INT is LIST[ELEM-TO-NAT] endm

in list2

th POSET is sort Elt .
  op _<_ : Elt Elt -> Bool .
  vars E1 E2 E3 : Elt .
  eq E1 < E1 = false .
  cq E1 < E3 = true if E1 < E2 and E2 < E3 .
endth

th TOSET is using POSET .
  vars E1 E2 E3 : Elt .
  cq E1 < E2 or E2 < E1 = true if E1 =/= E2 .
endth

obj BUBBLES[X :: TOSET] is
  protecting LIST[X] .
  op sorting_ : List -> List .
  op sorted_ : List -> Bool .
  vars L L' L'' : List .
  vars E E' : Elt .
  cq sorting L = L if sorted L .
  cq sorting L E E' L'' = sorting L E' E L'' if E' < E .
  eq sorted nil = true .
  eq sorted E = true .
  cq sorted E E' L = sorted E' L if E < E' or E == E' .
endo

in bubbles

view NATD from POSET to NAT is
  vars L1 L2 : Elt .
  op L1 < L2 to L1 divides L2 and L1 =/= L2 .
endv

reduce in A is BUBBLES[NAT]  : sorting(18 5 6 3) . ***> should be: 3 5 6 18
reduce sorting(8 5 4 2) .                          ***> should be: 2 4 5 8
reduce in B is BUBBLES[NATD] : sorting(18 5 6 3) . ***> mightnt contain: 3 6 18
reduce sorting(8 5 4 2) .                          ***> mightnt contain: 2 4 8

in lib/list
in lib/array

*** the expressions of Fun
obj EXP is dfn Env is ARRAY[QID,INT] .
  sorts IntExp BoolExp .
  subsorts Int Id < IntExp .
  subsorts Bool < BoolExp .
  ops (_and_)(_or_) : BoolExp BoolExp -> BoolExp .
  op not_ : BoolExp -> BoolExp .
  op _<_ : IntExp IntExp -> BoolExp .
  op _=_ : IntExp IntExp -> BoolExp .
  op if_then_else_fi : BoolExp IntExp IntExp -> IntExp .
  ops (_+_)(_-_)(_*_) : IntExp IntExp -> IntExp .
  op [[_]]_ : IntExp Env -> Int .
  op [[_]]_ : BoolExp Env -> Bool .
  var N : Int .         var T : Bool .
  vars E E' : IntExp .  vars B B' : BoolExp .
  var I : Id .          var V : Env .
  eq [[ N ]] V = N .
  eq [[ I ]] V  = V [ I ] .
  eq [[ E + E' ]] V = ([[ E ]] V) + ([[ E' ]] V) .
  eq [[ E - E' ]] V = ([[ E ]] V) - ([[ E' ]] V) .
  eq [[ E * E' ]] V = ([[ E ]] V) * ([[ E' ]] V) .
  eq [[ T ]] V = T .
  eq [[ E < E' ]] V = ([[ E ]] V) < ([[ E' ]] V) .
  eq [[(E = E')]] V = ([[ E ]] V) == ([[ E' ]] V) .
  eq [[ B and B' ]] V = ([[ B ]] V) and ([[ B' ]] V) .
  eq [[ B or  B' ]] V = ([[ B ]] V) or  ([[ B' ]] V) .
  eq [[ not B ]] V = not([[ B ]] V) .
  eq [[ if B then E else E' fi ]] V =
        if [[ B ]] V then [[ E ]] V else [[ E' ]] V fi .
endo

*** the statements of Fun
obj STMT is sort Stmt .
  protecting EXP .
  op _;_ : Stmt Stmt -> Stmt [assoc] .
  op _:=_ : Id IntExp -> Stmt .
  op while_do_od : BoolExp Stmt -> Stmt .
  op [[_]]_ : Stmt Env -> Env .
  vars S S' : Stmt .    var V : Env .
  var E : IntExp .      var B : BoolExp .
  var I : Id .
  eq [[ I := E ]] V = put(I,[[ E ]] V, V) .
  eq [[ S ; S' ]] V = [[ S' ]] [[ S ]] V .
  eq [[ while B do S od ]] V = if [[ B ]] V then
     [[ while B do S od ]] [[ S ]] V else V fi .
endo

*** evaluation of Fun programs
obj FUN is sorts Fun Init .
  protecting STMT .
  dfn IdList is LIST[QID] .
  dfn IntList is LIST[INT] .
  dfn InitList is (LIST *(op nil to nil-init, op (__) to (_;_)))[Init] .
  op _initially_ : Id IntExp -> Init [prec 1].
  op fun _ _ is vars _ body: _ : Id IdList InitList Stmt -> Fun .
  op [[_:=_]]_ : IdList IntList Env -> Env .
  op [[_]]_ : InitList Env -> Env .
  op [[_]][_]_ : Fun Env IntList -> Env .
  op [[_]]_ : Fun IntList -> Int .
  op wrong#args : -> Env .   *** err-op
  vars I F : Id .     var Is : IdList .
  var N : Int .       var Ns : IntList .
  var E : IntExp .    var INs : InitList .
  var S : Stmt .      var V : Env .
  eq [[ nil-init ]] V = V .
  eq [[(I initially E); INs ]] V = [[ INs ]] [[ I := E ]] V .
  eq [[ I Is := N Ns ]] V = ([[ I := N ]] ([[ Is := Ns ]] V)).STMT .
  eq [[(nil).IdList := (nil).IntList ]] V = V .
  eq [[ fun F(Is) is vars nil-init body: S ]][ V ](Ns) = [[ S ]] V .
  eq [[ fun F(Is) is vars INs body: S ]][ V ](Ns) =
        [[ S ]] [[ INs ]] [[ Is := Ns ]] V .
  eq [[ fun F(Is) is vars INs body: S ]](Ns) =
        [[ fun F(Is) is vars INs body: S ]][ nilArr ](Ns) [ F ] .
  cq [[ Is := Ns ]] V = wrong#args if | Is | =/= | Ns | .  *** err-qn
endo

*** pow(n m) finds the nth power of m for positive n or 0
reduce [[ fun 'pow('n 'm) is vars 'pow initially 1 body:
          while 0 < 'n do ('pow := 'pow * 'm);('n := 'n - 1) od ]](4 2) .
***> should be: 16

*** factorial of n
reduce [[ fun 'fac('n) is vars ('fac initially 1);('i initially 0) body:
          while 'i < 'n do ('i := 'i + 1); ('fac := 'i * 'fac) od ]](5) .
***> should be: 120

*** max finds the maximum of a list of three numbers
reduce [[ fun 'max('a 'b 'c) is vars 'n initially 2 body:
          ('max := 'a); while 0 < 'n do
          ('n := 'n - 1); ('x := 'b); ('b := 'c);
          ('max := if 'x < 'max then 'max else 'x fi) od ]](3 123 32) .
***> should be: 123

obj NAT is sort Nat .
  op 0 : -> Nat .
  op s_ : Nat -> Nat [prec 1] .
  op _+_ : Nat Nat -> Nat [assoc comm prec 3] .
  vars M N : Nat .
  eq M + 0 = M .
  eq M + s N = s(M + N).
  op _*_ : Nat Nat -> Nat [prec 2] .
  eq M * 0 = 0 .
  eq M * s N = M * N + M .
endo
obj VARS is protecting NAT .
  ops m n : -> Nat .
endo

***> first show two lemmas, 0*n=0 and sm*n=m*n+n
***> base for first lemma
reduce 0 * 0 == 0 .
***> induction step for first lemma
obj HYP1 is using VARS .
  eq 0 * n = 0 .
endo
reduce 0 * s n == 0 .
*** thus we can assert
obj LEMMA1 is protecting NAT .
  vars N : Nat .
  eq 0 * N = 0 .
endo

***> base for second lemma
reduce in VARS + LEMMA1 : s n * 0 == n * 0 + 0 .
***> induction step for second lemma
obj HYP2 is using VARS .
  eq s m * n = m * n + n .
endo
reduce s m * s n == (m * s n)+ s n .
*** so we can assert
obj LEMMA2 is protecting NAT .
  vars M N : Nat .
  eq s M * N = M * N + N .
endo

obj SUM is protecting NAT .
  op sum : Nat -> Nat .
  var N : Nat .
  eq sum(0) = 0 .
  eq sum(s N) = s N + sum(N) .
endo
***> show sum(n)+sum(n)=n*sn
***> base case
reduce in SUM + LEMMA1 : sum(0) + sum(0) == 0 * s 0 .
***> induction step
obj HYP is using SUM + VARS .
  eq sum(n) + sum(n) = n * s n .
endo
reduce in HYP + LEMMA2 : sum(s n) + sum(s n) == s n * s s n .

in list

th FN is sort S .
  op f : S -> S .
endth

obj MAP[F :: FN] is protecting LIST[F] .
  op map : List -> List .
  var X : S .
  var L : List .
  eq map(nil) = nil .
  eq map(X L) = f(X) map(L) .
endo

in map

obj FNS is protecting INT .
  ops (sq_)(dbl_)(_*3) : Int -> Int .
  var N : Int .
  eq sq N = N * N .
  eq dbl N = N + N .
  eq N *3 = N * 3 .
endo

reduce in MAP[(sq_).FNS] : map(0 nil 1 -2 3) .  ***> should be: 0 1 4 9
reduce in MAP[(dbl_).FNS] : map(0 1 -2 3) .     ***> should be: 0 2 -4 6
reduce in MAP[(_*3).FNS] : map(0 1 -2 nil 3) .  ***> should be: 0 3 -6 9