add vars

beautiful-racket-lib/br/stxparam.rkt

@@ -3,28 +3,35 @@
 (provide splicing-syntax-parameterize
          define-syntax-parameters
          define-language-variables
+         define-language-variable
          inject-language-variables
          (rename-out [br:define-syntax-parameter define-syntax-parameter]))
 
 (define-syntax (br:define-syntax-parameter stx)
   (syntax-case stx ()
-    [(_ ID STX)
+    [(_ ID STX) #'(define-syntax-parameter ID STX)]
-     #'(define-syntax-parameter ID STX)]
+    [(_ [ID VAL]) #'(define-syntax-parameter ID (λ (stx) #'VAL))]
-    [(_ ID)
+    [(_ ID) #'(define-syntax-parameter ID
-     #'(define-syntax-parameter ID (λ (stx) 
+                (λ (stx) (raise-syntax-error (syntax-e stx) "parameter not set")))]))
-                                     (raise-syntax-error (syntax-e stx) "parameter not set")))]))
 
 (define-syntax-rule (define-syntax-parameters ID ...)
   (begin (br:define-syntax-parameter ID) ...))
 
-(define-syntax define-language-variables (make-rename-transformer #'define-syntax-parameters))
+(define-syntax-rule (define-language-variable ID VAL)
+  (br:define-syntax-parameter [ID VAL]))
+
+(define-syntax-rule (define-language-variables [ID VAL] ...)
+  (begin (define-language-variable ID VAL) ...))
 
 (define-syntax (inject-language-variables stx)
   (syntax-case stx ()
-    [(_ ([VAR-PARAM INITIAL-VALUE] ...) LANG-CODE ...)
+    [(_ (VAR-PARAM ...) LANG-CODE ...)
-     (with-syntax ([(INTERNAL-NAME ...) (generate-temporaries #'(VAR-PARAM ...))])
+     (with-syntax ([(HOLDS-ORIG-PARAM-VALUE ...) (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
+                   [(INTERNAL-NAME ...) (generate-temporaries #'(VAR-PARAM ...))])
-           ([VAR-PARAM (make-rename-transformer #'INTERNAL-NAME)] ...)
+       ;; need to use splicing expressions in a module-begin to compose with requires etc. that might be in lang code
-         (define INTERNAL-NAME INITIAL-VALUE) ...
+       #'(splicing-let ([HOLDS-ORIG-PARAM-VALUE VAR-PARAM] ...)
-         (provide (rename-out [INTERNAL-NAME VAR-PARAM] ...))
+           (splicing-syntax-parameterize 
-         LANG-CODE ...))]))
+               ([VAR-PARAM (make-rename-transformer #'INTERNAL-NAME)] ...)
+             (define INTERNAL-NAME HOLDS-ORIG-PARAM-VALUE) ...
+             (provide (rename-out [INTERNAL-NAME VAR-PARAM] ...))
+             LANG-CODE ...)))]))

beautiful-racket/br/demo/basic/expander.rkt

@@ -3,20 +3,13 @@
          (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 br/stxparam)
-         br/stxparam)
 
-(define-language-variables A B C D E F A$)
+(define-language-variables [A 0][B 0][C 0][D 0][E 0][F 0][G 0][H 0][I 0][J 0][K 0][L 0][M 0][N 0][O 0][P 0][Q 0][R 0][S 0][T 0][U 0][V 0][W 0][X 0][Y 0][Z 0][A$ ""][B$ ""][C$ ""][D$ ""][E$ ""][F$ ""][G$ ""][H$ ""][I$ ""][J$ ""][K$ ""][L$ ""][M$ ""][N$ ""][O$ ""][P$ ""][Q$ ""][R$ ""][S$ ""][T$ ""][U$ ""][V$ ""][W$ ""][X$ ""][Y$ ""][Z$ ""])
 
 (define #'(basic-module-begin PARSE-TREE ...)
   #'(#%module-begin
-     (inject-language-variables ([A 0]
+     (inject-language-variables (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z A$ B$ C$ D$ E$ F$ G$ H$ I$ J$ K$ L$ M$ N$ O$ P$ Q$ R$ S$ T$ U$ V$ W$ X$ Y$ Z$)
-                                 [B 0]
-                                 [C 0]
-                                 [D 0]
-                                 [E 0]
-                                 [F 0]
-                                 [A$ "foo"])
        (println (quote PARSE-TREE ...))
        PARSE-TREE ...)))
 
@@ -24,7 +17,7 @@
 (define #'(basic-top . id)
   #'(begin
       (displayln (format "got unbound identifier: ~a" 'id))
-      (procedure-rename (λ xs (cons 'id xs)) (format-datum "undefined:~a" 'id))))
+      (procedure-rename (λ xs (cons 'id xs)) (string->symbol (format "undefined:~a" 'id)))))
 
 (define #'(program LINE ...) #'(run (list LINE ...)))
 
@@ -61,9 +54,7 @@
   [#'(value ID-OR-DATUM) #'ID-OR-DATUM])
 
 (define-cases expr
-  [(_ lexpr op rexpr) (if (op lexpr rexpr)
+  [(_ lexpr op rexpr) (if (op lexpr rexpr) 1 0)]
-                          1
-                          0)]
   [(_ expr) expr])
 (provide < > <= >=)