maude: program runner — module + reduce/rewrite commands (6 tests, 213 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
lib/maude/run.sx — mau/run-program / mau/run parse a module plus trailing reduce/red/rewrite/rew commands (with optional 'in MOD :' qualifier) and execute them, rendering results in mixfix surface syntax. An idiomatic .maude file now runs end-to-end. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -16,6 +16,7 @@ PRELOADS=(
|
|||||||
lib/maude/strategy.sx
|
lib/maude/strategy.sx
|
||||||
lib/maude/meta.sx
|
lib/maude/meta.sx
|
||||||
lib/maude/pretty.sx
|
lib/maude/pretty.sx
|
||||||
|
lib/maude/run.sx
|
||||||
)
|
)
|
||||||
|
|
||||||
SUITES=(
|
SUITES=(
|
||||||
@@ -27,4 +28,5 @@ SUITES=(
|
|||||||
"strategy:lib/maude/tests/strategy.sx:(mau-strategy-tests-run!)"
|
"strategy:lib/maude/tests/strategy.sx:(mau-strategy-tests-run!)"
|
||||||
"meta:lib/maude/tests/meta.sx:(mau-meta-tests-run!)"
|
"meta:lib/maude/tests/meta.sx:(mau-meta-tests-run!)"
|
||||||
"pretty:lib/maude/tests/pretty.sx:(mau-pretty-tests-run!)"
|
"pretty:lib/maude/tests/pretty.sx:(mau-pretty-tests-run!)"
|
||||||
|
"run:lib/maude/tests/run.sx:(mau-run-tests-run!)"
|
||||||
)
|
)
|
||||||
|
|||||||
83
lib/maude/run.sx
Normal file
83
lib/maude/run.sx
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
;; lib/maude/run.sx — run a Maude program: a module followed by commands.
|
||||||
|
;;
|
||||||
|
;; Parses a single fmod/mod ... endfm/endm module plus trailing commands and
|
||||||
|
;; executes them, Maude-style:
|
||||||
|
;; reduce TERM . (alias: red) — normalise with equations
|
||||||
|
;; rewrite TERM . (alias: rew) — apply rules under the default strategy
|
||||||
|
;; `... in MODNAME : TERM .` is accepted (the module qualifier is ignored —
|
||||||
|
;; there is one module in scope). Results are rendered in mixfix surface syntax.
|
||||||
|
|
||||||
|
(define
|
||||||
|
mau/module-end-idx
|
||||||
|
(fn
|
||||||
|
(toks i)
|
||||||
|
(cond
|
||||||
|
((>= i (len toks)) (- 0 1))
|
||||||
|
((or (= (nth toks i) "endfm") (= (nth toks i) "endm")) i)
|
||||||
|
(else (mau/module-end-idx toks (+ i 1))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mau/parse-module-from-toks
|
||||||
|
(fn
|
||||||
|
(toks)
|
||||||
|
(let
|
||||||
|
((kind (nth toks 0)) (name (nth toks 1)))
|
||||||
|
(mau/build-module
|
||||||
|
kind
|
||||||
|
name
|
||||||
|
(mau/take (mau/drop toks 3) (- (len toks) 4))))))
|
||||||
|
|
||||||
|
;; strip an optional `in MODNAME :` qualifier from a command's term tokens
|
||||||
|
(define
|
||||||
|
mau/strip-in
|
||||||
|
(fn
|
||||||
|
(toks)
|
||||||
|
(if
|
||||||
|
(and (not (empty? toks)) (= (first toks) "in"))
|
||||||
|
(rest (mau/drop-until toks ":"))
|
||||||
|
toks)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mau/run-command
|
||||||
|
(fn
|
||||||
|
(m stmt)
|
||||||
|
(let
|
||||||
|
((head (first stmt)) (term-toks (mau/strip-in (rest stmt))))
|
||||||
|
(let
|
||||||
|
((t (mau/parse-term term-toks (mau/module-grammar m))))
|
||||||
|
(cond
|
||||||
|
((or (= head "reduce") (= head "red")) {:cmd "reduce" :result (mau/term->maude m (mau/creduce m t))})
|
||||||
|
((or (= head "rewrite") (= head "rew")) {:cmd "rewrite" :result (mau/term->maude m (mau/rewrite m t))})
|
||||||
|
(else {:cmd head :result "?"}))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mau/run-commands
|
||||||
|
(fn
|
||||||
|
(m stmts)
|
||||||
|
(if
|
||||||
|
(empty? stmts)
|
||||||
|
(list)
|
||||||
|
(if
|
||||||
|
(empty? (first stmts))
|
||||||
|
(mau/run-commands m (rest stmts))
|
||||||
|
(cons
|
||||||
|
(mau/run-command m (first stmts))
|
||||||
|
(mau/run-commands m (rest stmts)))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mau/run-program
|
||||||
|
(fn
|
||||||
|
(src)
|
||||||
|
(let
|
||||||
|
((toks (mau/tokenize src)))
|
||||||
|
(let
|
||||||
|
((eidx (mau/module-end-idx toks 0)))
|
||||||
|
(let
|
||||||
|
((m (mau/parse-module-from-toks (mau/take toks (+ eidx 1))))
|
||||||
|
(cmd-toks (mau/drop toks (+ eidx 1))))
|
||||||
|
(mau/run-commands m (mau/split-statements cmd-toks)))))))
|
||||||
|
|
||||||
|
;; convenience: just the rendered result strings
|
||||||
|
(define
|
||||||
|
mau/run
|
||||||
|
(fn (src) (map (fn (r) (get r :result)) (mau/run-program src))))
|
||||||
@@ -1,8 +1,8 @@
|
|||||||
{
|
{
|
||||||
"lang": "maude",
|
"lang": "maude",
|
||||||
"total_passed": 207,
|
"total_passed": 213,
|
||||||
"total_failed": 0,
|
"total_failed": 0,
|
||||||
"total": 207,
|
"total": 213,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"parse","passed":65,"failed":0,"total":65},
|
{"name":"parse","passed":65,"failed":0,"total":65},
|
||||||
{"name":"reduce","passed":26,"failed":0,"total":26},
|
{"name":"reduce","passed":26,"failed":0,"total":26},
|
||||||
@@ -11,7 +11,8 @@
|
|||||||
{"name":"rewrite","passed":21,"failed":0,"total":21},
|
{"name":"rewrite","passed":21,"failed":0,"total":21},
|
||||||
{"name":"strategy","passed":19,"failed":0,"total":19},
|
{"name":"strategy","passed":19,"failed":0,"total":19},
|
||||||
{"name":"meta","passed":18,"failed":0,"total":18},
|
{"name":"meta","passed":18,"failed":0,"total":18},
|
||||||
{"name":"pretty","passed":11,"failed":0,"total":11}
|
{"name":"pretty","passed":11,"failed":0,"total":11},
|
||||||
|
{"name":"run","passed":6,"failed":0,"total":6}
|
||||||
],
|
],
|
||||||
"generated": "2026-06-07T15:31:52+00:00"
|
"generated": "2026-06-07T15:33:57+00:00"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# maude scoreboard
|
# maude scoreboard
|
||||||
|
|
||||||
**207 / 207 passing** (0 failure(s)).
|
**213 / 213 passing** (0 failure(s)).
|
||||||
|
|
||||||
| Suite | Passed | Total | Status |
|
| Suite | Passed | Total | Status |
|
||||||
|-------|--------|-------|--------|
|
|-------|--------|-------|--------|
|
||||||
@@ -12,3 +12,4 @@
|
|||||||
| strategy | 19 | 19 | ok |
|
| strategy | 19 | 19 | ok |
|
||||||
| meta | 18 | 18 | ok |
|
| meta | 18 | 18 | ok |
|
||||||
| pretty | 11 | 11 | ok |
|
| pretty | 11 | 11 | ok |
|
||||||
|
| run | 6 | 6 | ok |
|
||||||
|
|||||||
52
lib/maude/tests/run.sx
Normal file
52
lib/maude/tests/run.sx
Normal file
@@ -0,0 +1,52 @@
|
|||||||
|
;; lib/maude/tests/run.sx — running a Maude program (module + commands).
|
||||||
|
|
||||||
|
(define mrn-pass 0)
|
||||||
|
(define mrn-fail 0)
|
||||||
|
(define mrn-failures (list))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mrn-check!
|
||||||
|
(fn
|
||||||
|
(name got expected)
|
||||||
|
(if
|
||||||
|
(= got expected)
|
||||||
|
(set! mrn-pass (+ mrn-pass 1))
|
||||||
|
(do
|
||||||
|
(set! mrn-fail (+ mrn-fail 1))
|
||||||
|
(append!
|
||||||
|
mrn-failures
|
||||||
|
(str name " expected: " expected " got: " got))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mrn-peano
|
||||||
|
"fmod PEANO is\n sort Nat .\n op 0 : -> Nat .\n op s_ : Nat -> Nat .\n op _+_ : Nat Nat -> Nat .\n op _*_ : Nat Nat -> Nat .\n vars X Y : Nat .\n eq 0 + Y = Y .\n eq s X + Y = s (X + Y) .\n eq 0 * Y = 0 .\n eq s X * Y = Y + (X * Y) .\nendfm\nred s 0 + s s 0 .\nred 0 + 0 .\nreduce in PEANO : s s 0 * s s 0 .")
|
||||||
|
|
||||||
|
(mrn-check!
|
||||||
|
"peano-results"
|
||||||
|
(mau/run mrn-peano)
|
||||||
|
(list "(s (s (s 0)))" "0" "(s (s (s (s 0))))"))
|
||||||
|
|
||||||
|
(mrn-check! "peano-count" (len (mau/run-program mrn-peano)) 3)
|
||||||
|
(mrn-check!
|
||||||
|
"peano-cmd-kind"
|
||||||
|
(get (first (mau/run-program mrn-peano)) :cmd)
|
||||||
|
"reduce")
|
||||||
|
|
||||||
|
(define
|
||||||
|
mrn-coins
|
||||||
|
"mod COINS is\n sort M .\n op nil : -> M .\n op q : -> M .\n op d : -> M .\n op _;_ : M M -> M [assoc comm id: nil] .\n rl [change] : q ; q ; q ; q => d .\nendm\nrew q ; q ; q ; q ; q .\nrewrite q ; q ; q ; q ; q ; q ; q ; q .")
|
||||||
|
|
||||||
|
(mrn-check! "coins-results" (mau/run mrn-coins) (list "(d ; q)" "(d ; d)"))
|
||||||
|
|
||||||
|
(mrn-check!
|
||||||
|
"coins-cmd-kind"
|
||||||
|
(get (first (mau/run-program mrn-coins)) :cmd)
|
||||||
|
"rewrite")
|
||||||
|
|
||||||
|
;; module-only (no commands) runs to an empty result list
|
||||||
|
(mrn-check!
|
||||||
|
"no-commands"
|
||||||
|
(mau/run "fmod EMPTY is\n sort S .\n op a : -> S .\nendfm")
|
||||||
|
(list))
|
||||||
|
|
||||||
|
(define mau-run-tests-run! (fn () {:failures mrn-failures :total (+ mrn-pass mrn-fail) :passed mrn-pass :failed mrn-fail}))
|
||||||
@@ -105,6 +105,10 @@ The novel substrate stress: equational matching. Pattern `X + Y` against `1 + 2
|
|||||||
- [x] Mixfix surface-syntax printer (`lib/maude/pretty.sx`) — `mau/term->maude`
|
- [x] Mixfix surface-syntax printer (`lib/maude/pretty.sx`) — `mau/term->maude`
|
||||||
renders the internal prefix form back as Maude mixfix (`((s X) + 0)`),
|
renders the internal prefix form back as Maude mixfix (`((s X) + 0)`),
|
||||||
driven by op forms; `mau/red->maude` / `mau/rew->maude`. 11 tests.
|
driven by op forms; `mau/red->maude` / `mau/rew->maude`. 11 tests.
|
||||||
|
- [x] Program runner (`lib/maude/run.sx`) — `mau/run-program` / `mau/run` parse
|
||||||
|
a module plus trailing `reduce`/`red`/`rewrite`/`rew TERM .` commands
|
||||||
|
(`... in MOD : TERM` qualifier accepted) and execute them, rendering results
|
||||||
|
in surface syntax. Runs an idiomatic `.maude` file end-to-end. 6 tests.
|
||||||
|
|
||||||
### Phase 8 — Propose `lib/guest/rewriting/`
|
### Phase 8 — Propose `lib/guest/rewriting/`
|
||||||
- [ ] Extract equational matching engine (the most reusable piece).
|
- [ ] Extract equational matching engine (the most reusable piece).
|
||||||
|
|||||||
Reference in New Issue
Block a user