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

** add/expose parameter for logging 'hits'

Browse Source
This commit is contained in:
Ben Greenman 2016-06-06 17:38:01 -04:00
parent dc0c4bcad8
commit 066d89d993
3 changed files with 44 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
trivial/parameters.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/racket/base
(provide
(all-from-out trivial/private/parameters))
(require
trivial/private/parameters)

41
trivial/private/common.rkt
View File

@ -27,6 +27,7 @@
)
(require
trivial/private/parameters
racket/syntax
syntax/parse
syntax/id-table
@ -121,21 +122,31 @@
f-let))
(define ((make-alias id-stx parser) stx)
(or (parser stx)
(syntax-parse stx
[_:id
id-stx]
[(_ e* ...)
#:with app-stx (format-id stx "#%app")
#`(app-stx #,id-stx e* ...)])))
(cond
[(parser stx)
=> (lambda (r)
(when (*TRIVIAL-LOG*) (printf "[LOG] alias ~a\n" (syntax->datum id-stx)))
r)]
[else
(syntax-parse stx
[_:id
id-stx]
[(_ e* ...)
#:with app-stx (format-id stx "#%app")
#`(app-stx #,id-stx e* ...)])]))
(define ((make-keyword-alias id-sym parser) stx)
(or (parser stx)
(cond
[(parser stx)
=> (lambda (r)
(when (*TRIVIAL-LOG*) (printf "[LOG] keyword ~a\n" id-sym))
r)]
[else
(syntax-parse stx
[(_ e* ...)
#:with id-stx (case id-sym
[(define) #'tr:define]
[(let) #'tr:let]
[(set!) #'tr:set!]
[else (error 'trivial "Unknown keyword '~a'" id-sym)])
(syntax/loc stx (id-stx e* ...))])))
[(_ e* ...)
#:with id-stx (case id-sym
[(define) #'tr:define]
[(let) #'tr:let]
[(set!) #'tr:set!]
[else (error 'trivial "Unknown keyword '~a'" id-sym)])
(syntax/loc stx (id-stx e* ...))])]))

11
trivial/private/parameters.rkt Normal file
View File

@ -0,0 +1,11 @@
#lang typed/racket/base
(provide
*TRIVIAL-LOG*
)
;; =============================================================================
(: *TRIVIAL-LOG* (Parameterof Boolean))
(define *TRIVIAL-LOG* (make-parameter #f))