underscore prefix for nonliterals

beautiful-racket-lib/br/define.rkt

@@ -5,13 +5,13 @@
 ;; everything is prefixed br: whether it needs it or not so it can be stripped by #lang br
 
 (define-for-syntax (generate-literals pats)
-  ;; generate literals for any symbols that are not ... or _ or UPPERCASE
+  ;; generate literals for any symbols that are not ... or _ or _underscore-prefixed
   (for*/list ([pat-arg (in-list (flatten (map (λ(stx) (or (syntax->list stx) stx)) (syntax->list pats))))]
               [pat-datum (in-value (syntax->datum pat-arg))]
               #:when (and (symbol? pat-datum)
                           (not (eq? pat-datum '...)) (not (eq? pat-datum '_))
                           (not (let ([str (symbol->string pat-datum)])
-                                 (equal? (string-upcase str) str)))))
+                                 (regexp-match #rx"^_" str)))))
              pat-arg))
 
 ;; todo: support `else` case
@@ -62,7 +62,7 @@
   (define (foo-func) 'got-foo-func)
   (br:define-cases #'op
                    [#'(_ "+") #''got-plus]
-                   [#'(_ ARG) #''got-something-else]
+                   [#'(_ _ARG) #''got-something-else]
                    [#'(_) #'(foo-func)]
                    [#'_ #'foo-val])
   
@@ -129,20 +129,20 @@
   (br:define #'plusser #'plus)
   (check-equal? (plusser 42) +)
   (check-equal? plusser +)
-  (br:define #'(times ARG) #'(* ARG ARG))
+  (br:define #'(times _ARG) #'(* _ARG _ARG))
   (check-equal? (times 10) 100)
   (br:define #'timeser #'times)
   (check-equal? (timeser 12) 144)
   (br:define #'fortytwo #'42)
   (check-equal? fortytwo 42)
   (check-equal? (let ()
-                  (br:define #'(foo X)
+                  (br:define #'(foo _X)
                              (with-syntax ([zam +])
-                               #'(zam X X))) (foo 42)) 84) 
+                               #'(zam _X _X))) (foo 42)) 84) 
   ;; todo: error from define not trapped by check-exn 
   #;(check-exn exn:fail:syntax? (λ _ (br:define (#'times stx stx2) #'*)))
   (begin
-    (br:define #'(redefine ID) #'(define ID 42))
+    (br:define #'(redefine _id) #'(define _id 42))
     (redefine zoombar)
     (check-equal? zoombar 42)))
 
@@ -164,11 +164,11 @@
   (require rackunit racket/port)
   (parameterize ([current-output-port (open-output-nowhere)])
     (check-equal? (let ()
-                    (br:debug-define #'(foo X Y Z)
+                    (br:debug-define #'(foo _X _Y _Z)
-                                     #'(apply + (list X Y Z)))
+                                     #'(apply + (list _X _Y _Z)))
                     (foo 1 2 3)) 6)  
     (check-equal? (let ()
-                    (br:debug-define #'(foo X ...) #'(apply * (list X ...)))
+                    (br:debug-define #'(foo _X ...) #'(apply * (list _X ...)))
                     (foo 10 11 12)) 1320)))
 
 

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

@@ -10,11 +10,11 @@
 
 (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 ...)
+(define #'(basic-module-begin _parse-tree ...)
   #'(#%module-begin
      (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$)
-                                (println (quote PARSE-TREE ...))
+                                (println (quote _parse-tree ...))
-                                PARSE-TREE ...)))
+                                _parse-tree ...)))
 
 ; #%app and #%datum have to be present to make #%top work
 (define #'(basic-top . id)
@@ -22,7 +22,7 @@
       (displayln (format "got unbound identifier: ~a" 'id))
       (procedure-rename (λ xs (cons 'id xs)) (string->symbol (format "undefined:~a" 'id)))))
 
-(define #'(program LINE ...) #'(run (list LINE ...)))
+(define #'(program _line ...) #'(run (list _line ...)))
 
 
 (struct exn:line-not-found exn:fail ())
@@ -53,50 +53,50 @@
              (add1 program-counter))])))
   (void))
 
-(define #'(cr-line ARG ...) #'(begin ARG ...))
+(define #'(cr-line _arg ...) #'(begin _arg ...))
 
 
 (define current-return-stack (make-parameter empty))
 
 (define-cases #'line
-  [#'(_ NUMBER (statement-list (statement "GOSUB" WHERE)))
+  [#'(_ _NUMBER (statement-list (statement "GOSUB" _WHERE)))
-   #'(cons NUMBER
+   #'(cons _NUMBER
            (λ _
              (let ([return-stack (current-return-stack)])
                (cond
                  [(or (empty? return-stack)
-                      (not (= NUMBER (car return-stack))))
+                      (not (= _NUMBER (car return-stack))))
-                  (current-return-stack (cons NUMBER (current-return-stack)))
+                  (current-return-stack (cons _NUMBER (current-return-stack)))
-                  (basic:GOTO WHERE)]
+                  (basic:GOTO _WHERE)]
                  [else (current-return-stack (cdr (current-return-stack)))]))))]
-  [#'(_ NUMBER STATEMENT-LIST) #'(cons NUMBER (λ _ STATEMENT-LIST))])
+  [#'(_ _NUMBER _STATEMENT-LIST) #'(cons _NUMBER (λ _ _STATEMENT-LIST))])
 
 (define-cases #'statement-list
-  [#'(_ STATEMENT) #'(begin STATEMENT)]
+  [#'(_ _STATEMENT) #'(begin _STATEMENT)]
-  [#'(_ STATEMENT ":" STATEMENT-LIST) #'(begin STATEMENT STATEMENT-LIST)])
+  [#'(_ _STATEMENT ":" _STATEMENT-LIST) #'(begin _STATEMENT _STATEMENT-LIST)])
 
 (define-cases #'statement
-  [#'(statement ID "=" EXPR) #'(set! ID EXPR)]
+  [#'(statement _ID "=" _EXPR) #'(set! _ID _EXPR)]
   ;[#'(statement "PRINT" ARG ...) #'(print ARG ...)]
   ;[#'(statement "RETURN" ARG ...) #'(return ARG ...)]
   ;[#'(statement "END" ARG ...) #'(end ARG ...)]
-  [#'(statement PROC-STRING ARG ...)
+  [#'(statement _proc-string _arg ...)
-   (inject-syntax ([#'PROC-ID (format-datum "basic:~a" #'PROC-STRING)])
+   (inject-syntax ([#'PROC-ID (format-datum "basic:~a" #'_proc-string)])
-                  #'(PROC-ID ARG ...))])
+                  #'(PROC-ID _arg ...))])
 
 (define-cases #'basic:IF
-  [#'(_ COND "THEN" TRUE-RESULT "ELSE" FALSE-RESULT)
+  [#'(_ _COND "THEN" _TRUE-RESULT "ELSE" _FALSE-RESULT)
-   #'(if (true? COND)
+   #'(if (true? _COND)
-         TRUE-RESULT
+         _TRUE-RESULT
-         FALSE-RESULT)]
+         _FALSE-RESULT)]
-  [#'(_ COND "THEN" TRUE-RESULT)
+  [#'(_ _COND "THEN" _TRUE-RESULT)
    #'(when (true? COND)
-       TRUE-RESULT)])
+       _TRUE-RESULT)])
 
 (define-cases #'value
-  [#'(value "(" EXPR ")") #'EXPR]
+  [#'(value "(" _EXPR ")") #'_EXPR]
-  [#'(value ID "(" ARG ... ")") #'(ID ARG ...)]
+  [#'(value _ID "(" _ARG ... ")") #'(_ID _ARG ...)]
-  [#'(value ID-OR-DATUM) #'ID-OR-DATUM])
+  [#'(value _ID-OR-DATUM) #'_ID-OR-DATUM])
 
 (define true? (compose1 not zero?))
 (define (cond->int cond) (if cond 1 0))
@@ -104,26 +104,26 @@
 (define (basic:or . args) (cond->int (ormap true? args)))
 
 (define-cases #'expr
-  [#'(_ COMP-EXPR "AND" SUBEXPR) #'(basic:and COMP-EXPR SUBEXPR)]
+  [#'(_ _COMP-EXPR "AND" _SUBEXPR) #'(basic:and _COMP-EXPR _SUBEXPR)]
-  [#'(_ COMP-EXPR "OR" SUBEXPR) #'(basic:or COMP-EXPR SUBEXPR)]
+  [#'(_ _COMP-EXPR "OR" _SUBEXPR) #'(basic:or _COMP-EXPR _SUBEXPR)]
-  [#'(_ COMP-EXPR) #'COMP-EXPR])
+  [#'(_ _COMP-EXPR) #'_COMP-EXPR])
 
 (define-cases #'comp-expr
-  [#'(_ LEXPR "=" REXPR) #'(comp-expr LEXPR "equal?" REXPR)] ; special case because = is overloaded
+  [#'(_ _LEXPR "=" _REXPR) #'(comp-expr _LEXPR "equal?" _REXPR)] ; special case because = is overloaded
-  [#'(_ LEXPR op REXPR) (inject-syntax ([#'OP (string->symbol (syntax->datum #'op))])
+  [#'(_ _LEXPR _op _REXPR) (inject-syntax ([#'OP (string->symbol (syntax->datum #'_op))])
-                                       #'(cond->int (OP LEXPR REXPR)))]
+                                       #'(cond->int (OP _LEXPR _REXPR)))]
-  [#'(_ ARG) #'ARG])
+  [#'(_ _ARG) #'_ARG])
 (define <> (compose1 not equal?))
 
 (define-cases #'sum
-  [#'(_ TERM "+" SUM) #'(+ TERM SUM)]
+  [#'(_ _TERM "+" _SUM) #'(+ _TERM _SUM)]
-  [#'(_ TERM "-" SUM) #'(- TERM SUM)]
+  [#'(_ _TERM "-" _SUM) #'(- _TERM _SUM)]
-  [#'(_ TERM) #'TERM])
+  [#'(_ _TERM) #'_TERM])
 
 (define-cases #'product
-  [#'(_ FACTOR "*" PRODUCT) #'(* FACTOR PRODUCT)]
+  [#'(_ _FACTOR "*" _PRODUCT) #'(* _FACTOR _PRODUCT)]
-  [#'(_ FACTOR "/" PRODUCT) #'(/ FACTOR PRODUCT)]
+  [#'(_ _FACTOR "/" _PRODUCT) #'(/ _FACTOR _PRODUCT)]
-  [#'(_ FACTOR) #'FACTOR])
+  [#'(_ _FACTOR) #'_FACTOR])
 
 (define print-list list)
 
@@ -136,17 +136,17 @@
     [(list print-list-item ...) (for-each displayln print-list-item)]))
 
 (define (TAB num) (make-string num #\space))
-(define #'(INT ARG ...) #'(inexact->exact (truncate (expr ARG ...))))
+(define #'(INT _ARG ...) #'(inexact->exact (truncate (expr _ARG ...))))
 (define (SIN num) (sin num))
 (define (ABS num) (inexact->exact (abs num)))
 (define (RND num) (* (random) num))
 
 (define-cases #'basic:INPUT
-  [#'(_ PRINT-LIST ";" ID)
+  [#'(_ _PRINT-LIST ";" _ID)
    #'(begin
-       (basic:PRINT (append PRINT-LIST (list ";")))
+       (basic:PRINT (append _PRINT-LIST (list ";")))
-       (basic:INPUT ID))]
+       (basic:INPUT _ID))]
-  [#'(_ ID) #'(set! ID (let* ([str (read-line)]
+  [#'(_ _ID) #'(set! _ID (let* ([str (read-line)]
                               [num (string->number str)])
                          (if num num str)))])
 

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

@@ -1,13 +1,13 @@
 #lang br
 
-(define #'(bf-module-begin PARSE-TREE ...)
+(define #'(bf-module-begin _PARSE-TREE ...)
   #'(#%module-begin
-     PARSE-TREE ...)) 
+     _PARSE-TREE ...)) 
 (provide (rename-out [bf-module-begin #%module-begin])
          #%top-interaction)
 
-(define #'(bf-program OP-OR-LOOP ...)
+(define #'(bf-program _OP-OR-LOOP ...)
-  #'(begin OP-OR-LOOP ...))
+  #'(begin _OP-OR-LOOP ...))
 (provide bf-program)
 
 (define-cases #'op
@@ -30,7 +30,7 @@
 (define (set-current-byte! val)
   (vector-set! bf-vector bf-pointer val))
 
-(define #'(loop "[" OP-OR-LOOP ... "]")
+(define #'(loop "[" _OP-OR-LOOP ... "]")
   #'(until (zero? (get-current-byte))
-           OP-OR-LOOP ...))
+           _OP-OR-LOOP ...))
 (provide loop)

beautiful-racket/br/demo/stacker.rkt

@@ -9,9 +9,9 @@
                       SRC-EXPR ...))))
 (provide read-syntax)
 
-(define #'(stacker-module-begin READER-LINE ...)
+(define #'(stacker-module-begin _READER-LINE ...)
   #'(#%module-begin
-     READER-LINE ...
+     _READER-LINE ...
      (display (first stack))))
 (provide (rename-out [stacker-module-begin #%module-begin]))
 (provide #%top-interaction)