rose-ash/lib/maude/tests/strategy.sx

;; lib/maude/tests/strategy.sx — Phase 6: strategy language.

(define mst-pass 0)
(define mst-fail 0)
(define mst-failures (list))

(define
  mst-check!
  (fn
    (name got expected)
    (if
      (= got expected)
      (set! mst-pass (+ mst-pass 1))
      (do
        (set! mst-fail (+ mst-fail 1))
        (append!
          mst-failures
          (str name "  expected: " expected "  got: " got))))))

;; ---- a branching system; meaning depends on the strategy ----

(define
  mst-mod
  (mau/parse-module
    "mod CHOICE is\n  sort S .\n  ops a b c x y : -> S .\n  rl [r1] : a => b .\n  rl [r2] : b => c .\n  rl [toX] : a => x .\n  rl [toY] : a => y .\nendm"))

(define mst-env {})
(dict-set! mst-env "twice" (mau/s-seq (mau/s-rule "r1") (mau/s-rule "r2")))
(dict-set! mst-env "anyplus" (mau/s-plus (mau/s-all)))
(dict-set! mst-env "norm" (mau/s-bang (mau/s-all)))

;; basic combinators
(mst-check!
  "idle"
  (mau/srun-canon mst-mod mst-env (mau/s-idle) "a")
  (list "a"))
(mst-check! "fail" (mau/srun-canon mst-mod mst-env (mau/s-fail) "a") (list))
(mst-check!
  "single-rule"
  (mau/srun-canon mst-mod mst-env (mau/s-rule "r1") "a")
  (list "b"))
(mst-check!
  "single-rule-x"
  (mau/srun-canon mst-mod mst-env (mau/s-rule "toX") "a")
  (list "x"))
(mst-check!
  "all"
  (mau/srun-canon mst-mod mst-env (mau/s-all) "a")
  (list "b" "x" "y"))

;; sequencing: order matters
(mst-check!
  "seq-ok"
  (mau/srun-canon
    mst-mod
    mst-env
    (mau/s-seq (mau/s-rule "r1") (mau/s-rule "r2"))
    "a")
  (list "c"))
(mst-check!
  "seq-fail"
  (mau/srun-canon
    mst-mod
    mst-env
    (mau/s-seq (mau/s-rule "r2") (mau/s-rule "r1"))
    "a")
  (list))

;; alternation: union
(mst-check!
  "alt"
  (mau/srun-canon
    mst-mod
    mst-env
    (mau/s-alt (mau/s-rule "toX") (mau/s-rule "toY"))
    "a")
  (list "x" "y"))
(mst-check!
  "alt-with-fail"
  (mau/srun-canon
    mst-mod
    mst-env
    (mau/s-alt (mau/s-rule "r2") (mau/s-rule "r1"))
    "a")
  (list "b"))

;; iteration
(mst-check!
  "star"
  (mau/srun-canon mst-mod mst-env (mau/s-star (mau/s-all)) "a")
  (list "a" "b" "c" "x" "y"))
(mst-check!
  "plus"
  (mau/srun-canon mst-mod mst-env (mau/s-plus (mau/s-all)) "a")
  (list "b" "c" "x" "y"))
(mst-check!
  "bang-normal-forms"
  (mau/srun-canon mst-mod mst-env (mau/s-bang (mau/s-all)) "a")
  (list "c" "x" "y"))
(mst-check!
  "star-from-b"
  (mau/srun-canon mst-mod mst-env (mau/s-star (mau/s-all)) "b")
  (list "b" "c"))

;; named strategies + strategy expressions as values
(mst-check!
  "named-twice"
  (mau/srun-canon mst-mod mst-env (mau/s-name "twice") "a")
  (list "c"))
(mst-check!
  "named-anyplus"
  (mau/srun-canon mst-mod mst-env (mau/s-name "anyplus") "a")
  (list "b" "c" "x" "y"))
(mst-check!
  "named-norm"
  (mau/srun-canon mst-mod mst-env (mau/s-name "norm") "a")
  (list "c" "x" "y"))

;; nested composition: (r1 ; r2) | toX
(mst-check!
  "nested"
  (mau/srun-canon
    mst-mod
    mst-env
    (mau/s-alt
      (mau/s-seq (mau/s-rule "r1") (mau/s-rule "r2"))
      (mau/s-rule "toX"))
    "a")
  (list "c" "x"))

;; ---- a 1-D walk: strategy chooses how far ----

(define
  mst-walk
  (mau/parse-module
    "mod WALK is\n  sort Pos .\n  op 0 : -> Pos .\n  op s_ : Pos -> Pos .\n  op p : Pos -> Pos .\n  var X : Pos .\n  rl [step] : p(X) => p(s X) .\nendm"))

(mst-check!
  "walk-one"
  (mau/srun-canon mst-walk {} (mau/s-rule "step") "p(0)")
  (list "p(s_(0))"))
(mst-check!
  "walk-twice"
  (mau/srun-canon
    mst-walk
    {}
    (mau/s-seq (mau/s-rule "step") (mau/s-rule "step"))
    "p(0)")
  (list "p(s_(s_(0)))"))

(define mau-strategy-tests-run! (fn () {:failures mst-failures :total (+ mst-pass mst-fail) :passed mst-pass :failed mst-fail}))