diff --git a/beautiful-racket-lib/br/#stxparam.rkt#1# b/beautiful-racket-lib/br/#stxparam.rkt#1# deleted file mode 100644 index a70a888..0000000 --- a/beautiful-racket-lib/br/#stxparam.rkt#1# +++ /dev/null @@ -1,241 +0,0 @@ -#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 index b94d993..8f79fe3 100644 --- a/beautiful-racket-lib/br/stxparam.rkt +++ b/beautiful-racket-lib/br/stxparam.rkt @@ -1,34 +1,30 @@ #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 ...)])) +(require (for-syntax racket/base) racket/stxparam racket/splicing) +(provide splicing-syntax-parameterize + define-syntax-parameters + define-language-variables + inject-language-variables + (rename-out [br:define-syntax-parameter define-syntax-parameter])) + +(define-syntax (br:define-syntax-parameter stx) + (syntax-case stx () + [(_ ID STX) + #'(define-syntax-parameter ID STX)] + [(_ ID) + #'(define-syntax-parameter ID (λ (stx) + (raise-syntax-error (syntax-e stx) "parameter not set")))])) -(define-syntax syntax-let (make-rename-transformer #'add-syntax)) +(define-syntax-rule (define-syntax-parameters ID ...) + (begin (br:define-syntax-parameter ID) ...)) -(define-syntax inject-syntax (make-rename-transformer #'add-syntax)) +(define-syntax define-language-variables (make-rename-transformer #'define-syntax-parameters)) -(define-syntax (map-syntax stx) +(define-syntax (inject-language-variables 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 + [(_ ([VAR-PARAM INITIAL-VALUE] ...) LANG-CODE ...) + (with-syntax ([(INTERNAL-NAME ...) (generate-temporaries #'(VAR-PARAM ...))]) + #'(splicing-syntax-parameterize ;; need to use splicing version in a module-begin to compose with requires etc. that might be in lang code + ([VAR-PARAM (make-rename-transformer #'INTERNAL-NAME)] ...) + (define INTERNAL-NAME INITIAL-VALUE) ... + (provide (rename-out [INTERNAL-NAME VAR-PARAM] ...)) + LANG-CODE ...))])) diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt index 2980fe3..4a73694 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/beautiful-racket/br/demo/basic/expander.rkt @@ -3,19 +3,20 @@ (rename-out [basic-module-begin #%module-begin]) (rename-out [basic-top #%top]) (all-defined-out)) -(require (for-syntax racket/syntax racket/list br/datum)) +(require (for-syntax racket/syntax racket/list br/datum) + br/stxparam) -(require racket/stxparam racket/splicing) -(define-syntax-parameter A - (λ (stx) - (raise-syntax-error (syntax-e stx) "parameter not set"))) +(define-language-variables A B C D E F A$) (define #'(basic-module-begin PARSE-TREE ...) #'(#%module-begin - (splicing-syntax-parameterize - ([A (make-rename-transformer #'A-var)]) - (define A-var 0) - (provide (rename-out [A-var A])) + (inject-language-variables ([A 0] + [B 0] + [C 0] + [D 0] + [E 0] + [F 0] + [A$ "foo"]) (println (quote PARSE-TREE ...)) PARSE-TREE ...)))