-
Notifications
You must be signed in to change notification settings - Fork 5
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
148 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,22 @@ | ||
#lang racket/base | ||
(module+ test | ||
(require rackunit racket/port syntax-parse-example/log-once/log-once) | ||
|
||
(check-equal? | ||
(with-output-to-string | ||
(lambda () | ||
(for ([char (in-string "abcdefghijklmnopqrstuvwxyz")]) | ||
(log-once #:skip-count 18 | ||
#:log-count 3 | ||
char)))) | ||
"char = #\\s. \nchar = #\\t. \nchar = #\\u. \n") | ||
|
||
(check-equal? | ||
(with-output-to-string | ||
(lambda () | ||
(for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")]) | ||
(log-once #:skip-count 2 | ||
#:when (char-upper-case? char) | ||
char)))) | ||
"char = #\\Q. \n") | ||
) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,62 @@ | ||
#lang racket/base | ||
|
||
(require racket/function | ||
syntax/parse/define | ||
(for-syntax racket/base | ||
syntax/parse | ||
racket/format | ||
syntax/parse)) | ||
|
||
(provide log-once) | ||
|
||
(define log-var (curry printf "~a = ~s. ")) | ||
(define-syntax-parser log-def | ||
[(_ expr:expr) | ||
#`(log-var #,(~s (syntax->datum #'expr)) expr)]) | ||
|
||
(begin-for-syntax | ||
(define (make-incrementor id) | ||
(with-syntax ([id id]) | ||
#'(λ () | ||
(set! id (add1 id)) | ||
id)))) | ||
|
||
(define-syntax-parser log-defs | ||
[(_ (~optional (~seq #:newline use-newline-stx:boolean)) | ||
exprs*:expr ...+) | ||
#:attr use-newline (syntax-e #'(~? use-newline-stx #f)) | ||
#:attr intermediate-newline-clause (if (attribute use-newline) #'(newline) #f) | ||
#:attr ultimate-newline-clause (if (attribute use-newline) #f #'(newline)) | ||
#'(begin | ||
(~@ (log-def exprs*) | ||
(~? intermediate-newline-clause)) ... | ||
(~? ultimate-newline-clause))]) | ||
|
||
(define-syntax-parser log-once | ||
[(_ (~alt (~optional (~seq #:skip-count target-skip-count:nat) #:name "#:skip-count keyword" | ||
#:defaults ([target-skip-count #'0])) | ||
(~optional (~seq #:log-count target-log-count:nat) #:name "#:log-count keyword" | ||
#:defaults ([target-log-count #'1])) | ||
(~optional (~seq #:when condition:expr) #:name "#:when keyword") | ||
(~optional (~seq #:message message:str) #:name "#:message keyword") | ||
(~optional (~seq #:newline newline:boolean) #:name "#:newline keyword")) ... | ||
exprs* ...+) | ||
#:with logged (syntax-local-lift-expression #'#f) | ||
#:with run-count (syntax-local-lift-expression #'0) | ||
#:with ++run-count (make-incrementor #'run-count) | ||
#:with log-count (syntax-local-lift-expression #'0) | ||
#:with ++log-count (make-incrementor #'log-count) | ||
#:with should-run?! (syntax-local-lift-expression | ||
#'(λ () | ||
(and (> (++run-count) target-skip-count) | ||
(<= (++log-count) target-log-count)))) | ||
#:with stop-logging?! (syntax-local-lift-expression | ||
#'(λ () | ||
(when (<= target-log-count log-count) | ||
(set! logged #t)))) | ||
#'(and (not logged) | ||
(when (and (~? condition) | ||
(should-run?!)) | ||
(~? (display message)) | ||
(log-defs (~? (~@ #:newline newline)) exprs* ...) | ||
(stop-logging?!)))]) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,63 @@ | ||
#lang syntax-parse-example | ||
@require[ | ||
(for-label racket/base (only-in racket/math natural?) syntax/parse syntax-parse-example/log-once/log-once)] | ||
|
||
@(define log-once-eval | ||
(make-base-eval '(require syntax-parse-example/log-once/log-once))) | ||
|
||
@title{@tt{log-once}} | ||
|
||
@; ============================================================================= | ||
|
||
@defmodule[syntax-parse-example/log-once/log-once]{} | ||
@stxbee2021["Fictitious-Rotor" 3] | ||
|
||
@defproc[(log-once [#:skip-count skip natural? 0] | ||
[#:log-count log-count natural? 1] | ||
[#:when cond any/c (void)] | ||
[#:message msg string? ""] | ||
[#:newline newline? boolean? #f] | ||
[expr any/c] ...) void?]{ | ||
The purpose of this macro is to print a sample of values within tight loops---rather | ||
than inundate the console with thousands of lines of irrelevant data. | ||
It achieves this purpose by providing a variety of tools that can be used to | ||
constrain what is logged down to what actually interests the observer. | ||
|
||
@examples[#:eval log-once-eval | ||
(for ([char (in-string "abcdefghijklmnopqrstuvwxyz")]) | ||
(log-once #:skip-count 18 | ||
#:log-count 3 | ||
char)) | ||
|
||
(for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")]) | ||
(log-once #:skip-count 2 | ||
#:when (char-upper-case? char) | ||
char)) | ||
] | ||
|
||
The macro replaces patterns of code that would look something like this: | ||
|
||
@racketblock[ | ||
(code:comment "You have to define the variables somewhere where they won't") | ||
(code:comment " fall out of scope so that the mutations matter") | ||
(code:comment "You also have to be wary of leaving any of this code lying") | ||
(code:comment " around once you're finished with debugging") | ||
(define is-logged #f) | ||
(define skip-count 0) | ||
(for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")]) | ||
(when (and (not is-logged) | ||
(char-upper-case? char) | ||
(begin | ||
(set! skip-count (add1 skip-count)) | ||
(> skip-count 2))) | ||
(printf "char = ~s\n" char) | ||
(set! is-logged #t))) | ||
] | ||
|
||
The set of macros have gone through many revisions (@hyperlink["https://github.com/syntax-objects/Summer2021/issues/3" "link"]). | ||
This iteration makes use of @racket[~?], @racket[~@], | ||
@racket[syntax-local-lift-expression], and the excellent @racket[...]. | ||
|
||
@racketfile{log-once.rkt} | ||
|
||
} |