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

simplify

Browse Source
This commit is contained in:
Matthew Butterick 2016-05-13 16:22:11 -07:00
parent 9b2fa914f5
commit 12f8b3d0a5
2 changed files with 18 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
beautiful-racket-lib/br/syntax.rkt
View File

@ -80,7 +80,7 @@
(if (pair? sis-in)
(apply append sis-in)
(list
(let ([si (make-syntax-introducer 'use-site)])
(let ([si (make-syntax-introducer)])
(list (procedure-rename (curryr si 'add) 'add-id)
(procedure-rename (curryr si 'flip) 'flip-id)
(procedure-rename (curryr si 'remove) 'remove-id)))))))

41
beautiful-racket/br/demo/hdl-tst/expander.rkt
View File

@ -8,34 +8,27 @@
(displayln (format "got unbound identifier: ~a" 'id))
(procedure-rename (λ xs (cons 'id xs)) (string->symbol (format "undefined:~a" 'id)))))
(define #'(tst-program _arg ...)
#'(begin
_arg ...))
(define #'(tst-program _arg ...) #'(begin _arg ...))
(define-for-syntax output-here #'output-here)
(define #'(header-expr _filename (_colid ... _outid))
(with-syntax* ([filename-string (symbol->string (syntax->datum #'_filename))]
[procname (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))]
[output (shared-syntax 'output)])
#'(begin
(provide (all-defined-out))
(define procname (dynamic-require (findf file-exists? (list filename-string (format "~a.rkt" filename-string))) 'procname))
(display-header '_colid ... '_outid)
(define _colid (make-parameter 0)) ...
(define (_outid)
(keyword-apply procname
(map (compose1 string->keyword symbol->string) (list '_colid ...))
(list (_colid) ...) null))
(define (output)
(display-values (_colid) ... (_outid))))))
(define #'(load-expr _filename)
(inject-syntax ([#'filename-string (symbol->string (syntax->datum #'_filename))]
[#'proc-name (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))])
#'(filename-string proc-name)))
[output (syntax-local-introduce (datum->syntax #f 'output))])
#'(begin
(provide (all-defined-out))
(define procname
(dynamic-require (findf file-exists?
(list filename-string (format "~a.rkt" filename-string))) 'procname))
(display-header '_colid ... '_outid)
(define _colid (make-parameter 0)) ...
(define (_outid)
(keyword-apply procname
(map (compose1 string->keyword symbol->string) (list '_colid ...))
(list (_colid) ...) null))
(define (output)
(display-values (_colid) ... (_outid))))))
(define #'(display-header _sym ...)
#'(begin
@ -54,5 +47,5 @@
(define #'eval-expr #'void)
(define #'(output-expr)
(inject-syntax ([#'output (shared-syntax 'output)])
(inject-syntax ([#'output 'output])
#'(output)))