Skip to content

Commit bd8b1f4

Browse files
rfindlerrfindler
committed
add infrastructure to avoid all these out-of-sync copies of code
and use it to uncopy the code in mon-aft.scrbl
1 parent d4a8370 commit bd8b1f4

File tree

3 files changed

+136
-55
lines changed

3 files changed

+136
-55
lines changed

‎redex-doc/redex/scribblings/long-tut/code/mon-aft.rkt

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,8 @@ subst (if time, otherwise it's provide)
4747

4848
(module+ test
4949
(test-equal (in-Lambda? eb1) #false)
50-
(test-equal (in-Lambda? eb2) #false))
50+
(test-equal (in-Lambda? eb2) #false)
51+
) ;; close paren must be on this line or else mon-aft.scrbl won't run properly
5152

5253
;; -----------------------------------------------------------------------------
5354
;; (unique-vars x ...) is the sequence of variables x ... free of duplicates?

‎redex-doc/redex/scribblings/long-tut/mon-aft.scrbl

Lines changed: 19 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -25,18 +25,10 @@ To start a program with Redex, start your file with
2525
@codeblock{#lang racket
2626
(require redex)}
2727

28-
The @racket[define-language] from specifies syntax trees via tree grammars:
29-
@;%
30-
@(begin
31-
#reader scribble/comment-reader
32-
(racketblock
33-
(define-language Lambda
34-
(e ::= x
35-
(lambda (x) e)
36-
(e e ...))
37-
(x ::= variable-not-otherwise-mentioned))
38-
))
39-
@;%
28+
The @racket[define-language] from specifies syntax trees via tree grammars:
29+
30+
@codeblock-from-file["code/mon-aft.rkt" #rx"define-language Lambda" #:eval redex-eval]
31+
4032
The trees are somewhat concrete, which makes it easy to work with them, but
4133
it is confusing on those incredibly rare occasions when we want truly
4234
abstract syntax.
@@ -46,54 +38,28 @@ or integers (all of Racket's integers) or naturals (all of Racket's natural
4638
numbers)---and many other things.
4739

4840
After you have a syntax, use the grammar to generate instances and check
49-
them (typos do sneak in). Instances are generated with @racket[term]:
50-
@;
51-
@examples[#:label #f #:eval redex-eval
52-
(define e1 (term y))
53-
(define e2 (term (lambda (y) y)))
54-
(define e3 (term (lambda (x) (lambda (y) y))))
55-
(define e4 (term (,e2 ,e3)))
41+
them (typos do sneak in). Instances are generated with @racket[term]:
42+
@codeblock-from-file["code/mon-aft.rkt"
43+
#rx"define e1 [(]term"
44+
#:eval redex-eval
45+
#:exp-count 4
46+
#:extra-code ("e4")]
5647

57-
e4
58-
]
5948
Mouse over @racket[define]. It is @emph{not} a Redex form, it comes from
6049
Racket. Take a close look at the last definition. Comma anyone?
6150

62-
@;%
63-
@(begin
64-
#reader scribble/comment-reader
65-
(racketblock
66-
(redex-match? Lambda e e4)
67-
))
68-
@;%
69-
7051
Define yourself a predicate that tests membership:
71-
@;%
72-
@(begin
73-
#reader scribble/comment-reader
74-
(racketblock
75-
(define lambda? (redex-match? Lambda e))
76-
))
77-
@;%
78-
Now you can formulate language tests:
79-
@;%
80-
@(begin
81-
#reader scribble/comment-reader
82-
(racketblock
83-
(test-equal (lambda? e1) #true)
84-
(test-equal (lambda? e2) #true)
85-
(test-equal (lambda? e3) #true)
86-
(test-equal (lambda? e4) #true)
52+
@codeblock-from-file["code/mon-aft.rkt" #rx"define in-Lambda[?]" #:eval redex-eval]
8753

88-
(define eb1 (term (lambda (x) (lambda () y))))
89-
(define eb2 (term (lambda (x) (lambda (y) 3))))
54+
Now you can formulate language tests:
55+
@codeblock-from-file["code/mon-aft.rkt" #rx"test-equal [(]in-Lambda[?] e1"
56+
#:eval redex-eval #:exp-count 4]
57+
@codeblock-from-file["code/mon-aft.rkt" #rx"define eb1"
58+
#:eval redex-eval #:exp-count 2]
59+
@codeblock-from-file["code/mon-aft.rkt" #rx"test-equal [(]in-Lambda[?] eb1"
60+
#:eval redex-eval #:exp-count 2
61+
#:extra-code ("(test-results)")]
9062

91-
(test-equal (lambda? eb1) #false)
92-
(test-equal (lambda? eb2) #false)
93-
94-
(test-results)
95-
))
96-
@;%
9763
Make sure your language contains the terms that you want and does
9864
@emph{not} contain those you want to exclude. Why should @racket[eb1] and
9965
@racket[eb2] not be in @racket[Lambda]'s set of expressions?

‎redex-doc/redex/scribblings/long-tut/shared.rkt

Lines changed: 115 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,12 @@
11
#lang at-exp racket/base
2+
(module+ test (require rackunit))
3+
4+
#; #;
5+
(this is to facilitate
6+
some testing code
7+
that appears below)
8+
(it helps test
9+
codeblock-from-file)
210

311
(provide
412
goals ;; bulletize goals
@@ -10,16 +18,21 @@
1018
scribble/example
1119
racket/sandbox
1220
scribble/core
13-
scriblib/figure))
21+
scriblib/figure)
22+
codeblock-from-file)
1423

1524
;; -----------------------------------------------------------------------------
1625
(require
1726
"exercise/ex.rkt"
1827
(for-label racket/base redex/reduction-semantics)
28+
(for-syntax racket/base racket/match racket/list
29+
syntax/parse syntax/strip-context)
1930
scribble/manual
2031
scribble/core
2132
scribble/example
2233
racket/sandbox
34+
racket/runtime-path
35+
racket/list
2336
scriblib/figure)
2437

2538

@@ -51,3 +64,104 @@ to the top of your file:
5164
@;%
5265
}
5366
)
67+
68+
;; codeblock-from-file pulls a specific hunk of lines from
69+
;; one of the files in code/ and generates a use of `examples`
70+
;; with that code in it.
71+
;;
72+
;; Supply:
73+
;; - the name of the file as a relative path to the source
74+
;; location of the use of codeblock-from-file,
75+
;; - a regular expression that the first line to include must match
76+
;; - the evaluator to evaluate the program, with #:eval
77+
;; - the number of expressions that should follow (according to the
78+
;; rules of read) with #:exp-count, which defaults to 1
79+
;; - and a sequence of strings to tack onto the end of the expression
80+
;; these are treated as if they are extra lines in the file with
81+
;; #:extra-code
82+
;;
83+
;; if the expression begins with define, define-language or a few
84+
;; other keywords (see the match expression below), then the code
85+
;; is wrapped with eval:no-prompt (see examples for docs)
86+
;; the highlighting and linking is based on the for-label bindings
87+
;; that are at the use of codeblock-from-file
88+
(define-syntax (codeblock-from-file stx)
89+
(syntax-parse stx
90+
[(_ file:string rx-start:regexp #:eval eval
91+
(~optional (~seq #:exp-count number-of-expressions:integer))
92+
(~optional (~seq #:extra-code (extra-code:string ...))))
93+
94+
#`(examples #:label #f
95+
#:eval eval
96+
#,@(get-code (syntax-e #'file)
97+
(syntax-e #'rx-start)
98+
(if (attribute number-of-expressions)
99+
(syntax-e #'number-of-expressions)
100+
1)
101+
(if (attribute extra-code)
102+
(map
103+
syntax-e
104+
(syntax->list #'(extra-code ...)))
105+
'())
106+
stx))]))
107+
108+
(begin-for-syntax
109+
(define (get-code file rx:start number-of-expressions extra-code stx)
110+
(define src (syntax-source stx))
111+
(define-values (src-dir _1 _2) (split-path src))
112+
(define-values (in out) (make-pipe))
113+
(define-values (start-line end-line no-prompt?s)
114+
(get-start-and-end-lines file rx:start
115+
number-of-expressions
116+
stx
117+
src-dir))
118+
(call-with-input-file (build-path src-dir file)
119+
(λ (port)
120+
(for/list ([l (in-lines port)]
121+
[i (in-range end-line)]
122+
#:unless (< i start-line))
123+
(displayln l out))))
124+
(for ([extra-code-item (in-list extra-code)])
125+
(displayln extra-code-item out))
126+
(close-output-port out)
127+
(port-count-lines! in)
128+
(for/list ([no-prompt? (in-list (append no-prompt?s
129+
(make-list (length extra-code)
130+
#f)))])
131+
(define e (replace-context stx (read-syntax src in)))
132+
(if no-prompt?
133+
`(eval:no-prompt ,e)
134+
e)))
135+
136+
(define (get-start-and-end-lines file rx:start number-of-expressions stx src-dir)
137+
(define start-line
138+
(call-with-input-file (build-path src-dir file)
139+
(λ (port)
140+
(define count 0)
141+
(let/ec escape
142+
(for ([l (in-lines port)])
143+
(when (regexp-match? rx:start l)
144+
(escape))
145+
(set! count (+ count 1)))
146+
(raise-syntax-error 'codeblock-from-file
147+
(format "didn't find a line matching ~s" rx:start)
148+
stx))
149+
count)))
150+
(define-values (no-prompt?s end-line)
151+
(call-with-input-file (build-path src-dir file)
152+
(λ (port)
153+
(port-count-lines! port)
154+
(for ([i (in-range start-line)])
155+
(read-line port))
156+
(define no-prompt?s
157+
(for/list ([i (in-range number-of-expressions)])
158+
(define exp (read port))
159+
(when (eof-object? exp) (error 'codeblock-from-file "expression #~a not present in file" i))
160+
(match exp
161+
[`(define . ,stuff) #t]
162+
[`(define-language . ,stuff) #t]
163+
[`(test-equal . ,stuff) #t]
164+
[_ #f])))
165+
(define-values (line col pos) (port-next-location port))
166+
(values no-prompt?s line))))
167+
(values start-line end-line no-prompt?s)))

0 commit comments

Comments
 (0)