From 03e4d2c09870b72e9a57c26d93346ae17d1690c2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 20 Apr 2016 10:44:22 -0700 Subject: [PATCH] stxparam cont'd --- beautiful-racket-lib/br/#stxparam.rkt#1# | 241 ++++++++++++++++++++ beautiful-racket-lib/br/stxparam.rkt | 34 +++ beautiful-racket/br/demo/basic/expander.rkt | 15 +- 3 files changed, 283 insertions(+), 7 deletions(-) create mode 100644 beautiful-racket-lib/br/#stxparam.rkt#1# create mode 100644 beautiful-racket-lib/br/stxparam.rkt diff --git a/beautiful-racket-lib/br/#stxparam.rkt#1# b/beautiful-racket-lib/br/#stxparam.rkt#1# new file mode 100644 index 0000000..a70a888 --- /dev/null +++ b/beautiful-racket-lib/br/#stxparam.rkt#1# @@ -0,0 +1,241 @@ +#reader(lib"read.ss""wxme")WXME0108 ## +#| + This file uses the GRacket editor format. + Open this file in DrRacket version 6.4.0.15 or later to read it. + + Most likely, it was created by saving a program in DrRacket, + and it probably contains a program with non-text elements + (such as images or comment boxes). + + http://racket-lang.org/ +|# + 22 7 #"wxtext\0" +3 1 6 #"wxtab\0" +1 1 8 #"wximage\0" +2 0 8 #"wxmedia\0" +4 1 34 #"(lib \"syntax-browser.ss\" \"mrlib\")\0" +1 0 16 #"drscheme:number\0" +3 0 44 #"(lib \"number-snip.ss\" \"drscheme\" \"private\")\0" +1 0 36 #"(lib \"comment-snip.ss\" \"framework\")\0" +1 0 93 +( + #"((lib \"collapsed-snipclass.ss\" \"framework\") (lib \"collapsed-sni" + #"pclass-wxme.ss\" \"framework\"))\0" +) 0 0 43 #"(lib \"collapsed-snipclass.ss\" \"framework\")\0" +0 0 19 #"drscheme:sexp-snip\0" +0 0 36 #"(lib \"cache-image-snip.ss\" \"mrlib\")\0" +1 0 68 +( + #"((lib \"image-core.ss\" \"mrlib\") (lib \"image-core-wxme.rkt\" \"mr" + #"lib\"))\0" +) 1 0 29 #"drscheme:bindings-snipclass%\0" +1 0 101 +( + #"((lib \"ellipsis-snip.rkt\" \"drracket\" \"private\") (lib \"ellipsi" + #"s-snip-wxme.rkt\" \"drracket\" \"private\"))\0" +) 2 0 88 +( + #"((lib \"pict-snip.rkt\" \"drracket\" \"private\") (lib \"pict-snip.r" + #"kt\" \"drracket\" \"private\"))\0" +) 0 0 34 #"(lib \"bullet-snip.rkt\" \"browser\")\0" +0 0 25 #"(lib \"matrix.ss\" \"htdp\")\0" +1 0 22 #"drscheme:lambda-snip%\0" +1 0 29 #"drclickable-string-snipclass\0" +0 0 26 #"drracket:spacer-snipclass\0" +0 0 57 +#"(lib \"hrule-snip.rkt\" \"macro-debugger\" \"syntax-browser\")\0" +1 0 1 6 #"wxloc\0" + 0 0 62 0 1 #"\0" +0 75 1 #"\0" +0 12 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 0 9 +#"Standard\0" +0 75 15 #"Triplicate T3c\0" +0 16 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 -1 -1 2 24 +#"framework:default-color\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 255 255 255 -1 -1 2 +1 #"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 15 +#"text:ports out\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 119 34 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1 +-1 2 15 #"text:ports err\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 136 17 17 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 17 +#"text:ports value\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 34 119 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1 +-1 2 27 #"Matching Parenthesis Style\0" +0 -1 1 #"\0" +1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1 +-1 2 1 #"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 37 +#"framework:syntax-color:scheme:symbol\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 34 119 0 0 0 -1 -1 2 38 +#"framework:syntax-color:scheme:keyword\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 34 119 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 194 116 31 0 0 0 -1 -1 2 +38 #"framework:syntax-color:scheme:comment\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 119 34 119 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 37 +#"framework:syntax-color:scheme:string\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 119 34 0 0 0 -1 -1 2 35 +#"framework:syntax-color:scheme:text\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 119 34 0 0 0 -1 -1 2 39 +#"framework:syntax-color:scheme:constant\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 119 34 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 132 60 36 0 0 0 -1 -1 2 49 +#"framework:syntax-color:scheme:hash-colon-keyword\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 119 34 0 0 0 -1 -1 2 42 +#"framework:syntax-color:scheme:parenthesis\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 178 178 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 36 +#"framework:syntax-color:scheme:error\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 136 17 17 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 36 +#"framework:syntax-color:scheme:other\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 34 119 0 0 0 -1 -1 2 16 +#"Misspelled Text\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 81 112 203 0 0 0 -1 -1 2 +38 #"drracket:check-syntax:lexically-bound\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 81 112 203 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 28 +#"drracket:check-syntax:set!d\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 136 17 17 0 0 0 -1 -1 2 37 +#"drracket:check-syntax:unused-require\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 136 17 17 0 0 0 -1 -1 2 36 +#"drracket:check-syntax:free-variable\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 136 17 17 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 68 0 203 0 0 0 -1 -1 2 31 +#"drracket:check-syntax:imported\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 68 0 203 0 0 0 -1 -1 2 47 +#"drracket:check-syntax:my-obligation-style-pref\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 116 0 0 0 0 -1 -1 2 50 +#"drracket:check-syntax:their-obligation-style-pref\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 116 0 0 0 0 -1 -1 2 48 +#"drracket:check-syntax:unk-obligation-style-pref\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 139 142 28 0 0 0 -1 -1 2 +49 #"drracket:check-syntax:both-obligation-style-pref\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 139 142 28 0 0 0 -1 -1 2 +37 #"plt:module-language:test-coverage-on\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 2 38 +#"plt:module-language:test-coverage-off\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 4 1 +#"\0" +0 71 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 +-1 -1 4 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1 +-1 4 1 #"\0" +0 71 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1 +-1 4 1 #"\0" +0 71 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 100 0 0 0 0 -1 +-1 4 1 #"\0" +0 -1 1 #"\0" +1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 255 255 0 -1 -1 2 +1 #"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 200 0 0 0 0 0 -1 -1 4 1 +#"\0" +0 -1 1 #"\0" +1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 -1 -1 0 1 +#"\0" +0 75 15 #"Triplicate T3c\0" +0.0 16 90 -1 90 -1 3 -1 0 1 0 1 0 0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255 +255 255 1 -1 2 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 1 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255 +255 255 -1 -1 2 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 34 119 34 0 +0 0 -1 -1 2 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 136 17 17 0 +0 0 -1 -1 2 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 34 34 119 0 +0 0 -1 -1 2 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 119 34 119 0 +0 0 -1 -1 2 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 0 178 178 0 +0 0 -1 -1 2 1 #"\0" +0 -1 1 #"\0" +1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 0 0 0 0 0 0 +-1 -1 0 10 0 28 3 17 #"#lang racket/base" +0 0 24 29 1 #"\n" +0 0 24 3 1 #"(" +0 0 15 3 7 #"require" +0 0 24 3 1 #" " +0 0 14 3 15 #"racket/stxparam" +0 0 24 3 1 #" " +0 0 14 3 15 #"racket/splicing" +0 0 24 3 1 #")" +0 0 24 29 1 #"\n" +0 0 diff --git a/beautiful-racket-lib/br/stxparam.rkt b/beautiful-racket-lib/br/stxparam.rkt new file mode 100644 index 0000000..b94d993 --- /dev/null +++ b/beautiful-racket-lib/br/stxparam.rkt @@ -0,0 +1,34 @@ +#lang racket/base +(require (for-syntax racket/base syntax/parse) syntax/strip-context) +(provide (all-defined-out) (all-from-out syntax/strip-context)) + + +(define-syntax (syntax-match stx) + (syntax-case stx (syntax) + [(_ stx-arg [(syntax pattern) body ...] ...) + #'(syntax-case stx-arg () + [pattern body ...] ...)])) + +(define-syntax (add-syntax stx) + ;; todo: permit mixing of two-arg and one-arg binding forms + ;; one-arg form allows you to inject an existing syntax object using its current name + (syntax-case stx (syntax) + [(_ ([(syntax sid) sid-stx] ...) body ...) + #'(with-syntax ([sid sid-stx] ...) body ...)] + ;; todo: limit `sid` to be an identifier + [(_ ([sid] ...) body ...) + #'(with-syntax ([sid sid] ...) body ...)])) + +(define-syntax syntax-let (make-rename-transformer #'add-syntax)) + +(define-syntax inject-syntax (make-rename-transformer #'add-syntax)) + +(define-syntax (map-syntax stx) + (syntax-case stx () + [(_ ...) + #'(map (if (and (syntax? ) (list? (syntax-e ))) + (syntax->list ) + ) ...)])) + + +#;(define-syntax syntax-variable (make-rename-transformer #'format-id)) \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt index 2864387..2980fe3 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/beautiful-racket/br/demo/basic/expander.rkt @@ -5,18 +5,19 @@ (all-defined-out)) (require (for-syntax racket/syntax racket/list br/datum)) -(require racket/stxparam) +(require racket/stxparam racket/splicing) (define-syntax-parameter A (λ (stx) - (raise-syntax-error (syntax-e stx) "can only be used inside the place"))) + (raise-syntax-error (syntax-e stx) "parameter not set"))) (define #'(basic-module-begin PARSE-TREE ...) #'(#%module-begin - (let ([A-inner 0]) - (syntax-parameterize - ([A (make-rename-transformer #'A-inner)]) - (println (quote PARSE-TREE ...)) - PARSE-TREE ...)))) + (splicing-syntax-parameterize + ([A (make-rename-transformer #'A-var)]) + (define A-var 0) + (provide (rename-out [A-var A])) + (println (quote PARSE-TREE ...)) + PARSE-TREE ...))) ; #%app and #%datum have to be present to make #%top work (define #'(basic-top . id)