diff --git a/lib/maude/conformance.conf b/lib/maude/conformance.conf index ebd1ae5c..959cb205 100644 --- a/lib/maude/conformance.conf +++ b/lib/maude/conformance.conf @@ -16,6 +16,7 @@ PRELOADS=( lib/maude/strategy.sx lib/maude/meta.sx lib/maude/pretty.sx + lib/maude/run.sx ) SUITES=( @@ -27,4 +28,5 @@ SUITES=( "strategy:lib/maude/tests/strategy.sx:(mau-strategy-tests-run!)" "meta:lib/maude/tests/meta.sx:(mau-meta-tests-run!)" "pretty:lib/maude/tests/pretty.sx:(mau-pretty-tests-run!)" + "run:lib/maude/tests/run.sx:(mau-run-tests-run!)" ) diff --git a/lib/maude/run.sx b/lib/maude/run.sx new file mode 100644 index 00000000..7fa4b92e --- /dev/null +++ b/lib/maude/run.sx @@ -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)))) diff --git a/lib/maude/scoreboard.json b/lib/maude/scoreboard.json index 57c17a4e..0a41a831 100644 --- a/lib/maude/scoreboard.json +++ b/lib/maude/scoreboard.json @@ -1,8 +1,8 @@ { "lang": "maude", - "total_passed": 207, + "total_passed": 213, "total_failed": 0, - "total": 207, + "total": 213, "suites": [ {"name":"parse","passed":65,"failed":0,"total":65}, {"name":"reduce","passed":26,"failed":0,"total":26}, @@ -11,7 +11,8 @@ {"name":"rewrite","passed":21,"failed":0,"total":21}, {"name":"strategy","passed":19,"failed":0,"total":19}, {"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" } diff --git a/lib/maude/scoreboard.md b/lib/maude/scoreboard.md index a7a3dbba..14b03e2a 100644 --- a/lib/maude/scoreboard.md +++ b/lib/maude/scoreboard.md @@ -1,6 +1,6 @@ # maude scoreboard -**207 / 207 passing** (0 failure(s)). +**213 / 213 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -12,3 +12,4 @@ | strategy | 19 | 19 | ok | | meta | 18 | 18 | ok | | pretty | 11 | 11 | ok | +| run | 6 | 6 | ok | diff --git a/lib/maude/tests/run.sx b/lib/maude/tests/run.sx new file mode 100644 index 00000000..5e32ab9f --- /dev/null +++ b/lib/maude/tests/run.sx @@ -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})) diff --git a/plans/maude-on-sx.md b/plans/maude-on-sx.md index d2553656..d1cd7e70 100644 --- a/plans/maude-on-sx.md +++ b/plans/maude-on-sx.md @@ -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` renders the internal prefix form back as Maude mixfix (`((s X) + 0)`), 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/` - [ ] Extract equational matching engine (the most reusable piece).