suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

svn: r13257

Browse Source
This commit is contained in:
Robby Findler 2009-01-22 15:06:31 +00:00
parent a9686b7ca1
commit ebad17e4f7
3 changed files with 22 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/redex/private/bitmap-test.ss
View File

@ -42,6 +42,19 @@
(test (render-metafunction S)
"metafunction.png")
(define-metafunction lang
[(T x y)
1
(side-condition (not (eq? (term x) (term y))))]
[(T x x)
n
(where n 2)])
;; in this test, the metafunction has 2 clauses
;; with a side-condition on the first clause
;; and a 'where' in the second clause
(test (render-metafunction T) "metafunction-T.png")
;; in this test, teh `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not.
(test (render-lw
lang

15
collects/redex/private/pict.ss
View File

@ -659,21 +659,22 @@
[lhss (map (lambda (eqn)
(wrapper->pict
(metafunction-call (metafunc-proc-name (metafunction-proc mf))
(car eqn)
(list-ref eqn 0)
(metafunc-proc-multi-arg? (metafunction-proc mf)))))
eqns)]
[scs (map (lambda (eqn)
(if (and (null? (cadr eqn))
(null? (caddr eqn)))
(if (and (null? (list-ref eqn 1))
(null? (list-ref eqn 2)))
#f
(side-condition-pict null
(map wrapper->pict (cadr eqn))
(map wrapper->pict (list-ref eqn 1))
(map (lambda (p)
(cons (wrapper->pict (car p)) (wrapper->pict (cdr p))))
(caddr eqn))
(cons (wrapper->pict (car p))
(wrapper->pict (cdr p))))
(list-ref eqn 2))
+inf.0)))
eqns)]
[rhss (map (lambda (eqn) (wrapper->pict (cadddr eqn))) eqns)]
[rhss (map (lambda (eqn) (wrapper->pict (list-ref eqn 3))) eqns)]
[linebreak-list (or current-linebreaks
(map (lambda (x) #f) eqns))]
[=-pict (make-=)]

2
collects/redex/private/reduction-semantics.ss
View File

@ -1012,7 +1012,7 @@
(let ([term-fn (syntax-local-value prev-metafunction)])
#`(metafunc-proc-rhss #,(term-fn-get-id term-fn)))
#''())
(λ (f/dom cps rhss)
(λ (f/dom cps rhss)
(make-metafunc-proc
(let ([name (lambda (x) (f/dom x))]) name)
(list (list (to-lw lhs-for-lw)