Adds an alternative syntax for define-judgment-form rules
The conclusion may come last instead of first when a sequence of dashes precedes it.
This commit is contained in:
parent
dbfbf59256
commit
52c50dd67e
|
@ -1539,6 +1539,16 @@
|
||||||
(define-syntax-class contract-spec
|
(define-syntax-class contract-spec
|
||||||
#:description "contract specification"
|
#:description "contract specification"
|
||||||
(pattern (_:id _:expr ...)))
|
(pattern (_:id _:expr ...)))
|
||||||
|
(define (horizontal-line? id)
|
||||||
|
(regexp-match? #rx"^-+$" (symbol->string (syntax-e id))))
|
||||||
|
(define-syntax-class horizontal-line
|
||||||
|
(pattern x:id #:when (horizontal-line? #'x)))
|
||||||
|
(define (parse-rules rules)
|
||||||
|
(for/list ([rule rules])
|
||||||
|
(syntax-parse rule
|
||||||
|
[(prem ... _:horizontal-line conc)
|
||||||
|
#'(conc prem ...)]
|
||||||
|
[_ rule])))
|
||||||
(define-values (name/mode mode name/contract contract rules)
|
(define-values (name/mode mode name/contract contract rules)
|
||||||
(syntax-parse body #:context full-stx
|
(syntax-parse body #:context full-stx
|
||||||
[((~or (~seq #:mode ~! mode:mode-spec)
|
[((~or (~seq #:mode ~! mode:mode-spec)
|
||||||
|
@ -1558,7 +1568,7 @@
|
||||||
(raise-syntax-error
|
(raise-syntax-error
|
||||||
syn-err-name "expected at most one contract specification"
|
syn-err-name "expected at most one contract specification"
|
||||||
#f #f (syntax->list #'dups))])])
|
#f #f (syntax->list #'dups))])])
|
||||||
(values name/mode mode name/ctc ctc #'rules))]))
|
(values name/mode mode name/ctc ctc (parse-rules #'rules)))]))
|
||||||
(check-clauses full-stx syn-err-name rules #t)
|
(check-clauses full-stx syn-err-name rules #t)
|
||||||
(check-arity-consistency mode contract full-stx)
|
(check-arity-consistency mode contract full-stx)
|
||||||
(define-values (form-name dup-names)
|
(define-values (form-name dup-names)
|
||||||
|
|
|
@ -1069,7 +1069,7 @@ legtimate inputs according to @racket[metafunction-name]'s contract,
|
||||||
and @racket[#f] otherwise.
|
and @racket[#f] otherwise.
|
||||||
}
|
}
|
||||||
|
|
||||||
@defform/subs[#:literals (I O where)
|
@defform/subs[#:literals (I O where etc.)
|
||||||
(define-judgment-form language
|
(define-judgment-form language
|
||||||
option ...
|
option ...
|
||||||
rule ...)
|
rule ...)
|
||||||
|
@ -1079,12 +1079,22 @@ and @racket[#f] otherwise.
|
||||||
[contract-spec (code:line #:contract (form-id @#,ttpattern ...))]
|
[contract-spec (code:line #:contract (form-id @#,ttpattern ...))]
|
||||||
[pos-use I
|
[pos-use I
|
||||||
O]
|
O]
|
||||||
[rule [conclusion premise ...]]
|
[rule [conclusion
|
||||||
|
premise
|
||||||
|
...]
|
||||||
|
[premise
|
||||||
|
...
|
||||||
|
dashes
|
||||||
|
conclusion]]
|
||||||
[conclusion (form-id pat/term ...)]
|
[conclusion (form-id pat/term ...)]
|
||||||
[premise (judgment-form-id pat/term ...)
|
[premise (judgment-form-id pat/term ...)
|
||||||
(where @#,ttpattern @#,tttterm)]
|
(where @#,ttpattern @#,tttterm)]
|
||||||
[pat/term @#,ttpattern
|
[pat/term @#,ttpattern
|
||||||
@#,tttterm])]{
|
@#,tttterm]
|
||||||
|
[dashes ---
|
||||||
|
----
|
||||||
|
-----
|
||||||
|
etc.])]{
|
||||||
Defines @racket[form-id] as a relation on terms via a set of inference rules.
|
Defines @racket[form-id] as a relation on terms via a set of inference rules.
|
||||||
Each rule must be such that its premises can be evaluated left-to-right
|
Each rule must be such that its premises can be evaluated left-to-right
|
||||||
without ``guessing'' values for any of their pattern variables. Redex checks this
|
without ``guessing'' values for any of their pattern variables. Redex checks this
|
||||||
|
|
|
@ -1975,6 +1975,17 @@
|
||||||
(test (judgment-holds (uses-add2 (s (s (s (s z)))) n) n)
|
(test (judgment-holds (uses-add2 (s (s (s (s z)))) n) n)
|
||||||
(list (term (s (s (s z))))))
|
(list (term (s (s (s z))))))
|
||||||
|
|
||||||
|
(define-judgment-form nats
|
||||||
|
#:mode (hyphens I)
|
||||||
|
[(hyphens b)
|
||||||
|
-----------
|
||||||
|
(hyphens a)]
|
||||||
|
[(hyphens c)
|
||||||
|
-
|
||||||
|
(hyphens b)]
|
||||||
|
[(hyphens c)])
|
||||||
|
(test (judgment-holds (hyphens a)) #t)
|
||||||
|
|
||||||
(let-syntax ([test-trace
|
(let-syntax ([test-trace
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
[(_ expr trace-spec expected)
|
[(_ expr trace-spec expected)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user