giles
fecd3e4b0d
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
lib/maude/sorts.sx — mau/term-sort computes the least sort of a term (smallest result sort among op declarations whose arg sorts the actuals satisfy modulo subsorting); overloaded f(1)=NzNat vs f(s 0)=Nat. mau/has-sort? for membership-style checks. Answers the plan's order-sorted substrate question. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
88 lines
2.3 KiB
Plaintext
88 lines
2.3 KiB
Plaintext
;; lib/maude/sorts.sx — order-sorted least-sort inference.
|
|
;;
|
|
;; Order-sorted signatures: subsorts induce a partial order on sorts, and an
|
|
;; overloaded operator can have several declarations. The LEAST SORT of a term
|
|
;; is the smallest result sort among the operator declarations whose argument
|
|
;; sorts the actual arguments satisfy (modulo subsorting). This is what lets
|
|
;; `f(1)` be a NzNat while `f(s 0)` is only a Nat when f is declared at both.
|
|
;;
|
|
;; mau/term-sort M T -> least sort of T (string, "?" if unknown)
|
|
;; mau/has-sort? M T SORT -> does T's least sort fit under SORT?
|
|
|
|
(define
|
|
mau/arg-sorts-ok?
|
|
(fn
|
|
(m argsorts declared)
|
|
(cond
|
|
((and (empty? argsorts) (empty? declared)) true)
|
|
((or (empty? argsorts) (empty? declared)) false)
|
|
((mau/sort<=? m (first argsorts) (first declared))
|
|
(mau/arg-sorts-ok? m (rest argsorts) (rest declared)))
|
|
(else false))))
|
|
|
|
(define
|
|
mau/matching-ops
|
|
(fn
|
|
(m name argsorts)
|
|
(filter
|
|
(fn
|
|
(op)
|
|
(and
|
|
(= (len (get op :arity)) (len argsorts))
|
|
(mau/arg-sorts-ok? m argsorts (get op :arity))))
|
|
(mau/ops-named m name))))
|
|
|
|
(define
|
|
mau/least-loop
|
|
(fn
|
|
(m best rst)
|
|
(cond
|
|
((empty? rst) best)
|
|
((mau/sort<=? m (first rst) best)
|
|
(mau/least-loop m (first rst) (rest rst)))
|
|
(else (mau/least-loop m best (rest rst))))))
|
|
|
|
(define
|
|
mau/least-sort
|
|
(fn
|
|
(m sorts)
|
|
(if (empty? sorts) "?" (mau/least-loop m (first sorts) (rest sorts)))))
|
|
|
|
(define
|
|
mau/result-sort
|
|
(fn
|
|
(m name argsorts)
|
|
(let
|
|
((cands (mau/matching-ops m name argsorts)))
|
|
(if
|
|
(empty? cands)
|
|
(let
|
|
((any (mau/ops-named m name)))
|
|
(if (empty? any) "?" (get (first any) :result)))
|
|
(mau/least-sort m (map (fn (op) (get op :result)) cands))))))
|
|
|
|
(define
|
|
mau/term-sort
|
|
(fn
|
|
(m t)
|
|
(cond
|
|
((mau/var? t) (mau/vsort t))
|
|
((mau/app? t)
|
|
(mau/result-sort
|
|
m
|
|
(mau/op t)
|
|
(map (fn (a) (mau/term-sort m a)) (mau/args t))))
|
|
(else "?"))))
|
|
|
|
(define
|
|
mau/term-sort-src
|
|
(fn (m src) (mau/term-sort m (mau/parse-term-in m src))))
|
|
|
|
(define
|
|
mau/has-sort?
|
|
(fn (m t sort) (mau/sort<=? m (mau/term-sort m t) sort)))
|
|
|
|
(define
|
|
mau/has-sort-src?
|
|
(fn (m src sort) (mau/has-sort? m (mau/parse-term-in m src) sort)))
|