set show timing off .
set show advisories off .

***
***	Test getOneStepNarrowing() in the meta-interpreter.
***

load metaInterpreter

mod NARROW is
  sort Foo .
  op f : Foo Foo -> Foo [assoc comm] .
  ops g h : Foo -> Foo .
  ops a b c d e : -> Foo .

vars X Y Z W : Foo .
  rl g(f(X, X)) => h(X) [narrowing].
endm

mod NARROW-TEST is
  pr META-INTERPRETER .
  sort MsgList .
  subsort Msg < MsgList .
  op empty : -> MsgList .
  op _;_ : MsgList MsgList -> MsgList [assoc id: empty] .

  op me : -> Oid .
  op User : -> Cid .
  op soln:_ : Nat -> Attribute .
  op got:_  : MsgList -> Attribute .
  op start:_ : Term -> Attribute .
  op irred:_ : TermList -> Attribute .

  vars X Y Z : Oid .
  var AS : AttributeSet .
  vars N M : Nat .
  vars S S' : Substitution .
  var ST T : Term .
  var TY : Type .
  var C : Context .
  var Q L : Qid .
  var ML : MsgList .
  var TL : TermList .

  rl < X : User | AS > createdInterpreter(X, Y, Z) =>
     < X : User | AS > insertModule(Z, X, upModule('NARROW, true)) .

  rl < X : User | AS, start: ST, irred: TL > insertedModule(X, Y) =>
     < X : User | AS, soln: 1, start: ST, irred: TL, got: empty > getOneStepNarrowing(Y, X, 'NARROW, ST, TL, '#, 0) .

  rl < X : User | AS, soln: N, start: ST, irred: TL, got: ML >
     gotOneStepNarrowing(X, Y, M, T, TY, C, L, S, S', Q) =>
     < X : User | AS, soln: (N + 1),  start: ST, irred: TL, got: (ML ; gotOneStepNarrowing(X, Y, M, T, TY, C, L, S, S', Q)) >
      getOneStepNarrowing(Y, X, 'NARROW, ST, TL, '#, N) .

endm

set show breakdown on .

erew in NARROW-TEST : <> 
< me : User | start: ('g['f['#22:Foo, '#21:Foo, '#23:Foo]]), irred: empty > 
createInterpreter(interpreterManager, me, newProcess) .

mod NARROW is
  sort Foo .
  op f : Foo Foo -> Foo [assoc] .
  ops g h : Foo -> Foo .
  ops a b c d e : -> Foo .

vars X Y Z W : Foo .
  rl g(f(X, X)) => h(X) [narrowing].
endm

erew in NARROW-TEST : <> 
< me : User | start: ('g['f['#22:Foo, '#21:Foo, '#23:Foo]]), irred: empty > 
createInterpreter(interpreterManager, me, newProcess) .

erew in NARROW-TEST : <> 
< me : User | start: ('g['f['#22:Foo, '#22:Foo, '#23:Foo]]), irred: empty > 
createInterpreter(interpreterManager, me, newProcess) .

erew in NARROW-TEST : <> 
< me : User | start: ('g['f['#22:Foo, '#23:Foo, '#23:Foo]]), irred: empty > 
createInterpreter(interpreterManager, me, newProcess) .


mod XOR is
  sorts Elt Expr .
  subsort Elt < Expr .
  ops a b c d e : -> Elt .
  op _+_ : Expr Expr -> Expr [assoc comm] .
  op 0 : -> Elt .

vars W X Y Z : Expr .
  eq Y + 0 = Y [variant] .
  eq X + X = 0 [variant] .
  eq X + X + Y = Y [variant] .
endm

mod NARROW is inc XOR .
  ops g h : Expr -> Expr .
  op f : Expr Expr -> Expr .

vars W X Y Z : Expr .
  rl g(Y + a) => h(Y) [narrowing label one] .
endm

*** bound variable in irreducibility constraint
erew in NARROW-TEST : <> 
< me : User | start: ('f['g['_+_['W:Expr, 'b.Elt]], 'Z:Expr]), irred: ('_+_['W:Expr, 'b.Elt]) > 
createInterpreter(interpreterManager, me, newProcess) .

*** unbound variable in irreducibility constraint
erew in NARROW-TEST : <> 
< me : User | start: ('f['g['_+_['W:Expr, 'b.Elt]], 'Z:Expr]), irred: ('_+_['X:Expr, 'b.Elt]) > 
createInterpreter(interpreterManager, me, newProcess) .

*** # variable in input
erew in NARROW-TEST : <> 
< me : User | start: ('f['g['_+_['#1:Expr, 'b.Elt]], '#2:Expr]), irred: ('_+_['#3:Expr, 'b.Elt]) > 
createInterpreter(interpreterManager, me, newProcess) .


mod NARROW-TEST2 is
  pr META-INTERPRETER .
  sort MsgList .
  subsort Msg < MsgList .
  op empty : -> MsgList .
  op _;_ : MsgList MsgList -> MsgList [assoc id: empty] .

  op me : -> Oid .
  op User : -> Cid .
  op soln:_ : Nat -> Attribute .
  op got:_  : MsgList -> Attribute .
  op start:_ : Term -> Attribute .
  op irred:_ : TermList -> Attribute .

  vars X Y Z : Oid .
  var AS : AttributeSet .
  vars N M : Nat .
  vars S S' : Substitution .
  var ST T : Term .
  var TY : Type .
  var C : Context .
  var Q L : Qid .
  var ML : MsgList .
  var TL : TermList .

  rl < X : User | AS > createdInterpreter(X, Y, Z) =>
     < X : User | AS > insertModule(Z, X, upModule('NARROW, true)) .

  rl < X : User | AS, start: ST, irred: TL > insertedModule(X, Y) =>
     < X : User | AS, soln: 1, start: ST, irred: TL, got: empty >
     getOneStepNarrowing(Y, X, 'NARROW, ST, TL, '#, (delay filter), 0) .

  rl < X : User | AS, soln: N, start: ST, irred: TL, got: ML >
     gotOneStepNarrowing(X, Y, M, T, TY, C, L, S, S', Q) =>
     < X : User | AS, soln: (N + 1),  start: ST, irred: TL, got: (ML ; gotOneStepNarrowing(X, Y, M, T, TY, C, L, S, S', Q)) >
      getOneStepNarrowing(Y, X, 'NARROW, ST, TL, '#, (delay filter), N) .

endm

*** bound variable in irreducibility constraint
erew in NARROW-TEST2 : <> 
< me : User | start: ('f['g['_+_['W:Expr, 'b.Elt]], 'Z:Expr]), irred: ('_+_['W:Expr, 'b.Elt]) > 
createInterpreter(interpreterManager, me, newProcess) .

*** unbound variable in irreducibility constraint
erew in NARROW-TEST2 : <> 
< me : User | start: ('f['g['_+_['W:Expr, 'b.Elt]], 'Z:Expr]), irred: ('_+_['X:Expr, 'b.Elt]) > 
createInterpreter(interpreterManager, me, newProcess) .

*** # variable in input
erew in NARROW-TEST2 : <> 
< me : User | start: ('f['g['_+_['#1:Expr, 'b.Elt]], '#2:Expr]), irred: ('_+_['#3:Expr, 'b.Elt]) > 
createInterpreter(interpreterManager, me, newProcess) .


fmod EXCLUSIVE-OR is
  sorts Elem ElemXor .
  subsort Elem < ElemXor .
  ops a b c : -> Elem .
  op mt : -> ElemXor .
  op _*_ : ElemXor ElemXor -> ElemXor [assoc comm] .

  vars X Y Z U V : [ElemXor] .
  vars V1 V2 V3 V4 V5 V6 V7 V8 V9 : [ElemXor] .
  eq [idem] :     X * X = mt    [variant] .
  eq [idem-Coh] : X * X * Z = Z [variant] .
  eq [id] :       X * mt = X    [variant] .

  op f1 : [ElemXor] -> [ElemXor] .
  op f2 : [ElemXor] [ElemXor] -> [ElemXor] .
  op f3 : [ElemXor] [ElemXor] [ElemXor] -> [ElemXor] .
endfm

mod NARROW is inc EXCLUSIVE-OR .
vars W X Y Z : [ElemXor] .
  op f : ElemXor ElemXor -> ElemXor .

  rl X * Y => f(X, Y) [narrowing label one] .
endm

*** 57 unifiers
variant unify in NARROW : A:ElemXor * B:ElemXor =? X * Y .

*** 1 unifier
filtered variant unify in NARROW : A:ElemXor * B:ElemXor =? X * Y .

erew in NARROW-TEST : <>
< me : User |
start: ('_*_['A:ElemXor, 'B:ElemXor]),
irred: empty
> createInterpreter(interpreterManager, me, newProcess) .

erew in NARROW-TEST2 : <>
< me : User |
start: ('_*_['A:ElemXor, 'B:ElemXor]),
irred: empty
> createInterpreter(interpreterManager, me, newProcess) .
