demo langs for Racket School

beautiful-racket-demo/atomic-taco-demo/main.rkt

@@ -0,0 +1,14 @@
+#lang racket
+(provide #%datum #%top-interaction #%module-begin
+         (rename-out [#%my-app #%app]))
+
+(define-syntax (#%datum stx)
+  (syntax-case stx ()
+    [(_ . THING) #''taco]))
+
+(define-syntax (#%my-app stx)
+  (syntax-case stx ()
+    [(_ FUNC . ARGS) #'(list (#%datum) . ARGS)]))
+
+(module reader syntax/module-reader
+  atomic-taco-demo)

beautiful-racket-demo/atomic-taco-demo/test.rkt

@@ -0,0 +1,4 @@
+#lang atomic-taco-demo
+
+"hello world"
+(+ 1 (* 2 (- 3)))

beautiful-racket-demo/javascriptlike-demo/expander.rkt

@@ -0,0 +1,59 @@
+#lang br/quicklang
+(require racket/stxparam)
+(provide (all-defined-out) (all-from-out br/quicklang))
+
+(define-macro top #'begin)
+
+(define-macro (assignment ID VAL) #'(define ID VAL))
+
+(define (add/concat . xs)
+  (cond
+    [(andmap number? xs) (apply + xs)]
+    [(ormap string? xs) (string-join (map ~a xs) "")]))
+  
+(define-macro-cases sumlike
+  [(_ VAL) #'VAL]
+  [(_ . VALS) #'(add/concat . VALS)])
+
+(define-macro (object (K V) ...)
+  #'(make-hash (list (cons K V) ...)))
+
+(define-macro (func-def (ARG ...) STMT ...)
+  #'(λ (ARG ...)
+      (let/cc return-cc
+        (syntax-parameterize ([return (make-rename-transformer #'return-cc)])
+          STMT ... (void)))))
+
+(define-syntax-parameter return
+  (λ (stx) (error 'not-parameterized)))
+
+(define-macro (dotted-id (BASE KEY ...))
+  #'(for/fold ([val BASE])
+              ([key (in-list (list 'KEY ...))])
+      (cond
+        [(hash-ref val key #f)]
+        [(hash-ref val (symbol->string key) #f)]
+        [else (error 'dotted-failure)])))
+
+(define-macro func-app #'#%app)
+
+(define-macro (if COND . STMTS)
+  #'(when COND . STMTS))
+
+(define-macro-cases comparison
+  [(_ VAL) #'VAL]
+  [(_ L == R) #'(equal? L R)]
+  [(_ L != R) #'(not (equal? L R))])
+
+(define-macro (while COND STMT ...)
+  #'(let loop ()
+      (when COND
+        STMT ...
+        (loop))))
+
+(define alert displayln)
+
+(define-macro (increment ID)
+  #'(let ()
+      (set! ID (add1 ID))
+      ID))

beautiful-racket-demo/javascriptlike-demo/grammar.rkt

@@ -0,0 +1,23 @@
+#lang brag
+
+top : @statement*
+statement : (assignment | expr | return) /";" | if | while
+assignment : /"var" id /"=" expr
+@expr : comparison
+comparison : [comparison ("!=" | "==")] sumlike
+sumlike : [@sumlike /"+"] value 
+@value : id | INTEGER  | STRING | object | func-def | func-app | increment
+increment : id /"++"
+object : /"{" @kvs /"}"
+kvs : [kv (/"," kv)*]
+/kv : expr /":" expr
+func-def : /"function" /"(" ids /")" @block
+/ids : [id (/"," id)*]
+@id : ID | dotted-id
+dotted-id : DOTTED-ID
+block : /"{" @statement* /"}"
+return : /"return" expr
+func-app : id /"(" @exprs /")"
+exprs : [expr (/"," expr)*]
+if : /"if" /"(" expr /")" @block
+while : /"while" /"(" expr /")" @block

beautiful-racket-demo/javascriptlike-demo/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+
+(define compile-omit-paths '("less-rackety.rkt"))

beautiful-racket-demo/javascriptlike-demo/less-rackety.rkt

@@ -0,0 +1,102 @@
+#lang s-exp scriptlike
+;;
+;;var x = 42;
+;(define x 42)
+
+(var x 42)
+
+;;var s = "string";
+;(define s "string")
+
+(var s "string")
+
+;;
+;;x + x;
+;(define (add/concat . xs)
+;  (cond
+;    [(andmap number? xs) (apply + xs)]
+;    [(ormap string? xs) (string-join (map ~a xs) "")]))
+;(add/concat x x)
+
+(sumlike x x)
+
+;;s + x;
+;(add/concat s x)
+
+(sumlike s x)
+
+
+;;
+;;var thing = {
+;;    'foo' : 42,
+;;
+;;    'bar' : function(x) {
+;;        return x + 15;
+;;    }
+;;};
+
+;
+;(define thing (hash
+;               "foo" 42
+;               "bar" (λ (x) (let/ec return (return (add/concat x 15)) (void)))))
+;
+
+
+(object thing ("foo" 42) ("bar" (func (x) (return (sumlike x 15)))))
+
+;;thing.foo
+;;thing.bar
+;;thing.bar(3)
+
+;
+;(hash-ref thing "foo")
+;(hash-ref thing "bar")
+;(#%app (hash-ref thing "bar") 3)
+
+
+(dot thing "foo")
+(dot thing "bar")
+(func-app (dot thing "bar") 3)
+
+;
+;;
+;;if ( thing.foo == 42 ) {
+;;    console.log("The correct answer is " + thing.foo);
+;;}
+;
+;(when (equal? (hash-ref thing "foo") 42)
+;  (displayln (add/concat "The correct answer is " (hash-ref thing "foo"))))
+
+
+(object console ("log" (func (str) (pretty-print str))))
+
+(if (comparison (dot thing "foo") "==" 42)
+  (func-app (dot console "log") (sumlike "The correct answer is " (dot thing "foo"))))
+
+;
+;;var idx = 0;
+;;while ( idx != 50 ) {
+;;    if ( thing.bar(idx) == 35 ) {
+;;       alert("Calamity at " + idx + "!");
+;;    }
+;;    idx++;
+;;}
+;
+;(define (alert str)
+;  (displayln "*********")
+;  (displayln str)
+;  (displayln "*********"))
+;
+;(define idx 0)
+;(let loop ()
+;  (when (not (equal? idx 50))
+;    (when (equal? (#%app (hash-ref thing "bar") idx) 35)
+;      (alert (add/concat "Calamity at " idx "!")))
+;    (set! idx (add1 idx))
+;    (loop)))
+
+(var idx 0)
+(while (comparison idx "!=" 50)
+       (if (comparison (func-app (dot thing "bar") idx) "==" 35)
+           (alert (sumlike "Calamity at " idx "!")))
+       (increment idx))

beautiful-racket-demo/javascriptlike-demo/main.rkt

@@ -0,0 +1,33 @@
+#lang br/quicklang
+(require "grammar.rkt" brag/support)
+
+(module+ reader
+  (provide read-syntax))
+
+(define-lex-abbrev reserved-terms
+  (:or "var" "=" ";" "+" "{" "}" "'" "\""
+       ":" "," "(" ")" "//" "/*" "*/"
+       "if" "while" "==" "!=" "function" "return" "++"))
+
+(define lex
+  (lexer
+   [(:or (from/stop-before "//" "\n")
+         (from/to "/*" "*/")) (token 'COMMENT #:skip? #t)]
+   [reserved-terms (token lexeme (string->symbol lexeme))]
+   [(:+ (:- (:or alphabetic punctuation) "." reserved-terms))
+    (token 'ID (string->symbol lexeme))]
+   [(:+ (:- (:or alphabetic punctuation) reserved-terms))
+    (token 'DOTTED-ID (map string->symbol (string-split lexeme ".")))]
+   [(:+ (char-set "0123456789"))
+    (token 'INTEGER (string->number lexeme))]
+   [(:or (from/to "\"" "\"") (from/to "'" "'"))
+    (token 'STRING (string-trim lexeme (substring lexeme 0 1)))]
+   [whitespace (token 'WHITE #:skip? #t)]
+   [any-char lexeme]))
+
+(define (read-syntax src ip)
+  (define parse-tree (parse (λ () (lex ip))))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module _ javascriptlike-demo/expander
+         PT))))

beautiful-racket-demo/javascriptlike-demo/rackety.rkt

@@ -0,0 +1,64 @@
+#lang br
+;
+;var x = 42;
+(define x 42)
+;var s = "string";
+(define s "string")
+;
+;x + x;
+(define (add/concat . xs)
+  (cond
+    [(andmap number? xs) (apply + xs)]
+    [(ormap string? xs) (string-join (map ~a xs) "")]))
+(add/concat x x)
+;s + x;
+(add/concat s x)
+;
+;var thing = {
+;    'foo' : 42,
+;
+;    'bar' : function(x) {
+;        return x + 15;
+;    }
+;};
+
+(define thing (hash
+               "foo" 42
+               "bar" (λ (x) (let/ec return (return (add/concat x 15)) (void)))))
+
+;thing.foo
+;thing.bar
+;thing.bar(3)
+
+(hash-ref thing "foo")
+(hash-ref thing "bar")
+(#%app (hash-ref thing "bar") 3)
+
+;
+;if ( thing.foo == 42 ) {
+;    console.log("The correct answer is " + thing.foo);
+;}
+
+(when (equal? (hash-ref thing "foo") 42)
+  (displayln (add/concat "The correct answer is " (hash-ref thing "foo")))) 
+
+;var idx = 0;
+;while ( idx != 50 ) {
+;    if ( thing.bar(idx) == 35 ) {
+;       alert("Calamity at " + idx + "!");
+;    }
+;    idx++;
+;}
+
+(define (alert str)
+  (displayln "*********")
+  (displayln str)
+  (displayln "*********"))
+
+(define idx 0)
+(let loop ()
+  (when (not (equal? idx 50))
+    (when (equal? (#%app (hash-ref thing "bar") idx) 35)
+      (alert (add/concat "Calamity at " idx "!")))
+    (set! idx (add1 idx))
+    (loop)))

beautiful-racket-demo/javascriptlike-demo/sexped.rkt

@@ -0,0 +1,30 @@
+#lang s-exp scriptlike/expander
+
+(assignment x 42)
+(assignment s "string")
+
+(sumlike x x)
+(sumlike s x)
+
+(assignment thing (object
+                   ("foo" 42)
+        
+                   ("bar" (func-def (x)
+                                (return (sumlike x 15))))))
+
+
+
+(dotted-id (thing foo))
+(dotted-id (thing bar))
+(func-app (dotted-id (thing bar)) 3)
+
+(assignment console (object ("log" (func-def (str) (displayln str))))) ; simulates global console (don't put in parse tree)
+(if (comparison (dotted-id (thing foo)) == 42)
+    (func-app (dotted-id (console log)) (sumlike "The correct answer is " (dotted-id (thing foo)))))
+
+
+(assignment idx 0)
+(while (comparison idx != 50)
+       (if (comparison (func-app (dotted-id (thing bar)) idx) == 35)
+           (alert (sumlike "Calamity at " idx "!")))
+       (increment idx))

beautiful-racket-demo/javascriptlike-demo/test.rkt

@@ -0,0 +1,32 @@
+#lang javascriptlike-demo
+
+var x = 42;
+var s = "string";
+
+x + x; // prints 84
+s + x; // prints "string42"
+
+var thing = {
+    "foo" : 42,
+    'bar' : function(x) {
+        return x + 15;
+    }
+};
+
+thing.foo; // prints 42
+thing.bar; // prints #<procedure:...>
+thing.bar(3); // prints 18
+
+if ( thing.foo == 42 ) {
+    // prints "The correct answer is 42"
+    alert("The correct answer is " + thing.foo);
+}
+
+var idx = 0;
+while ( idx != 50 ) {
+    if ( thing.bar(idx) == 35 ) {
+       // prints "Calamity at 20!"
+       alert("Calamity at " + idx + "!"); 
+    }
+    idx++;
+}

beautiful-racket-demo/passthrough-demo/main.rkt

@@ -0,0 +1,5 @@
+#lang racket
+(provide (all-from-out racket))
+
+(module reader syntax/module-reader
+  passthrough-demo)

beautiful-racket-demo/passthrough-demo/test.rkt

@@ -0,0 +1,4 @@
+#lang passthrough-demo
+ 
+"hello world"
+(+ 1 (* 2 (- 3)))

beautiful-racket-demo/pl-checklist-demo/main.rkt

@@ -0,0 +1 @@
+#lang pl-checklist-lang-maker

beautiful-racket-demo/pl-checklist-demo/test.rkt

@@ -0,0 +1 @@
+#lang pl-checklist-demo

beautiful-racket-demo/pl-checklist-lang-maker/checklist.txt

@@ -0,0 +1,8 @@
+What kind of programming language do you propose to make?
+
+( ) concurrent ( ) declarative ( ) imperative ( ) functional
+( ) asynchronous ( ) typed ( ) untyped ( ) semi-typed ( ) non-terminating
+( ) lazy ( ) deterministic ( ) literate ( ) illiterate 
+( ) Forth-like ( ) Algol-inspired ( ) BASIC-infused ( ) Lispy
+( ) modular ( ) multiprocess ( ) scalable ( ) unreasonable
+( ) cloud-based ( ) ARM-compatible ( ) RISC-optimized

beautiful-racket-demo/pl-checklist-lang-maker/main.rkt

@@ -0,0 +1,63 @@
+#lang at-exp br/quicklang
+(require brag/support racket/runtime-path racket/file)
+
+(module reader syntax/module-reader
+  pl-checklist-lang-maker/main)
+
+(provide (rename-out [plc-mb #%module-begin]))
+
+(define-macro (plc-mb . ARGS)
+  #'(#%module-begin
+     (module+ main
+       (displayln "My new #lang technique is unstoppable"))
+     (module+ reader
+       (provide (rename-out [plc-rs read-syntax])))))
+
+
+(define (plc-rs path ip)
+  (strip-context
+   (with-syntax ([PT (parse (λ () (plc-lexer ip)))])
+     #'(module _ (submod pl-checklist-lang-maker expander)
+         PT))))
+
+(define plc-lexer
+  (lexer
+   [whitespace (token 'WHITE #:skip? #t)]
+   [(:: "(" (:? " ") ")") (token 'VALUE #f)]
+   [(:: "(" any-char ")") (token 'VALUE #t)]
+   [(:+ alphabetic punctuation) (token 'WORD lexeme)]))
+
+
+@module/lang[parser]{
+ #lang brag
+
+ plc-top : (/WORD | plc-field)*
+ /plc-field : VALUE WORD
+}
+
+(require 'parser)
+
+(module+ expander
+  (provide #%module-begin plc-top))
+
+(define-runtime-path checklist "checklist.txt")
+
+(define-macro-cases plc-top
+  [(_) #'(displayln (string-append "\n" (file->string checklist)))]
+  [(_ (VAL NAME) ...)
+   #'(let ([adjectives (map cdr (filter car (list '(VAL . NAME) ...)))])
+       (stringify adjectives))])
+
+(define (stringify adjectives)
+  (displayln "")
+  (display
+   (if (pair? adjectives)
+       (string-append
+        "You appear to be proposing a new "
+        (string-join adjectives ", ")
+        " language. "
+        (if (< (length adjectives) 6)
+            "\n\nThat will never work."
+            "\n\nNow you're showing some ambition! Welcome to Racket School!"))
+       "No language proposed. You are in danger of flunking out.")))
+

beautiful-racket-demo/pythonesque-demo/grammar.rkt

@@ -0,0 +1,19 @@
+#lang brag
+
+top : @statement*
+statement : assignment | func-def | expr | return | for | if | print
+assignment : ID /"=" expr
+@expr : comparison
+comparison : [comparison ("<" | ">")] sum
+sum : [sum ("+" | "-")] product
+product : [product ("*" | "/")] value
+@value : ID | INTEGER | func-app | STRING
+func-app : ID /"(" @exprs /")"
+exprs : [expr (/"," expr)*]
+func-def : /"def" ID /"(" ids /")" /":" @block
+/ids : [ID (/"," ID)*]
+block : /INDENT @statement* /DEDENT
+return : /"return" expr
+for : /"for" ID /"in" expr /":" @block
+if : /"if" expr /":" block [/"else" /":" block]
+print : /"print" expr

beautiful-racket-demo/pythonesque-demo/main.rkt

@@ -0,0 +1,96 @@
+#lang br/quicklang
+(require "grammar.rkt" brag/support racket/pretty racket/stxparam)
+(provide (except-out (all-from-out br/quicklang) for if print) (all-defined-out) pretty-print)
+
+(module+ reader
+  (provide read-syntax))
+
+(define-lex-abbrev reserved-terms
+  (:or "=" "def" "(" ")" ":" ","
+       "return" "for" "in"
+       "+" "-" "*" "/" "<" ">" "\""
+       "if" "else" "print"))
+(define-lex-abbrev indent (:: (:+ "\n") (:* " ")))
+
+(define prev-indent 0)
+(define pending-dedents 0)
+
+(define (lex ip)
+  (define inner-lex
+    (lexer
+     [(eof) (cond
+              [(> prev-indent 0)
+               (set! pending-dedents prev-indent)
+               (set! prev-indent 0)
+               (lex input-port)]
+              [else eof])]
+     [(from/stop-before "#" "\n") (token 'COMMENT #:skip? #t)]
+     [indent
+      (match-let* ([(list _ spaces) (regexp-match #rx"^\n+( *)$" lexeme)]
+                   [this-indent (/ (string-length spaces) 2)])
+        (define tok
+          (cond
+            [(> (- this-indent prev-indent) 1) (error 'only-one-indent-please)]
+            [(> this-indent prev-indent) (token 'INDENT)]
+            [(< this-indent prev-indent)
+             (set! pending-dedents (- prev-indent this-indent))
+             (lex input-port)]
+            [(= this-indent prev-indent) (token lexeme #:skip? #t)]))
+        (set! prev-indent this-indent)
+        tok)]
+     [(:+ whitespace) (token lexeme #:skip? #t)]
+     [reserved-terms (token lexeme (string->symbol lexeme))]
+     [(:+ (:- (:or alphabetic punctuation) reserved-terms))
+      (token 'ID (string->symbol lexeme))]
+     [(:+ (char-set "0123456789"))
+      (token 'INTEGER (string->number lexeme))]))
+  (cond
+    [(equal? (peek-char ip) #\") (token 'STRING (read ip))]
+    [(> pending-dedents 0)
+     (set! pending-dedents (sub1 pending-dedents))
+     (token 'DEDENT)]
+    [else (inner-lex ip)]))
+
+(define-macro top #'begin)
+(define-macro (assignment ID EXPR)
+  #'(define ID EXPR))
+
+(define-macro-cases comparison
+  [(_ ARG) #'ARG]
+  [(_ LARG OP RARG) #'(OP LARG RARG)])
+
+(define-macro sum #'comparison)
+(define-macro product #'comparison)
+
+(define-macro (func-def ID ID-ARGS STMT ...)
+  #'(define (ID . ID-ARGS)
+      (let/cc return-cc
+        (syntax-parameterize ([return (make-rename-transformer #'return-cc)])
+          STMT ... (void)))))
+
+(define-syntax-parameter return (λ (stx) (error 'not-parameterized)))
+(define-macro func-app #'#%app)
+
+(provide (rename-out [my-for for]))
+(define-macro (my-for ID EXPR . STMTS)
+  #'(for ([ID (in-list EXPR)])
+      . STMTS))
+
+(define-macro block #'begin)
+
+(provide (rename-out [my-if if]))
+(define-macro-cases my-if
+  [(_ COND TBLOCK) #'(when COND TRUE-BLOCK)]
+  [(_ COND TBLOCK FBLOCK) #'(if COND (let () TBLOCK) (let () FBLOCK))])
+
+(provide (rename-out [my-print print]))
+(define-macro (my-print EXPR)
+  #'(display EXPR))
+
+(define (read-syntax src ip)
+  (define parse-tree (parse (λ () (lex ip))))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module _ pythonesque-demo
+         #;(pretty-print 'PT)
+         PT))))

beautiful-racket-demo/pythonesque-demo/test.rkt

@@ -0,0 +1,51 @@
+#lang pythonesque-demo
+
+a = 3
+b = 4
+
+"middle \" escaped quote"
+"ending escaped quote\""
+"middle \\ escaped backslash"
+"ending escaped backslash\\"
+
+def ft():
+  return 42
+
+def gt(x, y):
+  return x > y
+  def noop():
+    return "double dedent here"
+
+
+def squaresum(x, y):
+  def add(c, d):
+    return c + d
+  return add(x, y) * add(x, y)
+
+gt(a, b) # #f
+squaresum(b, a) # 49
+
+println(a)
+
+expt(2, 4)
+
+range(1, 5)
+
+# keep indented example next to eof
+for x in range(1, 5):
+  println(x * x)
+
+def foo(x):
+  x
+
+foo(42) # no return value
+
+if a < b:
+  print "a is less than b"
+else:
+  print "a is not less than b"
+
+def bar(x, y):
+  return x > y
+  def noop():
+    return "double dedent here"

beautiful-racket-demo/quantum-taco-demo/main.rkt

@@ -0,0 +1,20 @@
+#lang br/quicklang
+
+(module+ reader
+  (provide read-syntax))
+
+(define (tokenize ip)
+  (for/list ([tok (in-port read ip)])
+            tok))
+
+(define (parse tok)
+  (if (list? tok)
+      (map parse tok)
+      'taco))
+
+(define (read-syntax src ip)
+  (define toks (tokenize ip))
+  (define parse-tree (parse toks))
+  (with-syntax ([(PT ...) parse-tree])
+    #'(module tacofied racket
+        'PT ...)))

beautiful-racket-demo/quantum-taco-demo/test.rkt

@@ -0,0 +1,4 @@
+#lang quantum-taco-demo
+
+"hello world"
+(+ 1 (* 2 (- 3)))

beautiful-racket-demo/regexcellent-demo/grammar.rkt

@@ -0,0 +1,16 @@
+#lang brag
+
+top : (/NEWLINE+ [line])* /NEWLINE*
+line : [lookbehind] pat [lookahead]
+pat : repeat+ | choice
+lookbehind : /"(" /"?" /"<" /"=" pat /")"
+lookahead : /"(" /"?" /"=" pat /")"
+choice : pat (/"|" pat)+
+repeat : repeatable [("*" | "+") ["?"] | "?"]
+@repeatable : group | any | start | end | literals | chars
+group : /"(" pat /")"
+any : /"."
+start : /"^"
+end : /"$"
+literals : LITERAL+
+chars : /"[" LITERAL* /"]"

beautiful-racket-demo/regexcellent-demo/main.rkt

@@ -0,0 +1,66 @@
+#lang br/quicklang
+(require brag/support "grammar.rkt")
+(provide (all-from-out br/quicklang) (all-defined-out))
+
+(module+ reader
+  (provide read-syntax))
+
+(define-lex-abbrev regex-chars (char-set "()*+?.^$|<!=[]"))
+  
+(define lex
+  (lexer
+   [(:+ "\n") (token 'NEWLINE lexeme)]
+   [(from/stop-before ";" "\n") (token 'COMMENT #:skip? #t)]
+   [(:+ whitespace) (token 'SP lexeme #:skip? #t)]
+   [regex-chars lexeme]
+   [alphabetic (token 'LITERAL lexeme)]))
+
+(define (read-syntax src ip)
+  (define parse-tree (parse (λ () (lex ip))))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module regexcellent-mod regexcellent-demo
+         (for ([line (in-list PT)])
+           (displayln line))))))
+
+(define-macro (top . LINES) #'(list . LINES))
+
+(define (line . pieces)
+  (format "This pattern matches ~a." (string-join pieces ", followed by ")))
+
+(define (pat . xs)
+  (if (= (length xs) 1)
+      (car xs)
+      (format "a sequence starting with ~a" (string-join xs ", followed by "))))
+
+(define (lookbehind pat)
+  (format "a lookbehind assertion of ~a" pat))
+(define (lookahead pat)
+  (format "a lookahead assertion of ~a" pat))
+
+(define (choice . pats)
+  (format "a choice of ~a" (string-join pats "; or ")))
+
+(define (repeat thing [quantifier #f] [maybe-non-greedy? #f])
+  (string-join
+   (filter values
+           (list thing
+                 (case quantifier
+                   [("*") "repeated zero or more times"]
+                   [("+") "repeated one or more times"]
+                   [("?") "zero or once"]
+                   [else #f])
+                 (and maybe-non-greedy? "non-greedily")))
+   " "))
+
+(define (group pat)
+  (format "the group containing ~a" pat))
+
+(define (any) "any character")
+(define (start) "the start of the input")
+(define (end) "the end of the input")
+
+(define (literals . strs)
+  (format "the literal string ~v" (string-join strs "")))
+(define (chars . lits)
+  (format "any member of the character set {~a}" (string-join (map ~v lits) ", ")))

beautiful-racket-demo/regexcellent-demo/test.rkt

@@ -0,0 +1,11 @@
+#lang regexcellent-demo
+
+foo
+.
+foo.
+^foo.$
+foo|bar
+foo?|bar*|zam+?
+[abc]+
+(foo*)(bar+)
+(?<=foo*)bar(?=zam)

beautiful-racket-demo/simplex-demo/grammar.rkt

@@ -0,0 +1,8 @@
+#lang brag
+
+top : func-def{2} func-app
+func-def : /"fun" ID /"(" argids /")" /"=" expr
+/argids : ID [/"," ID]
+expr : ID "+" ID | func-app
+func-app : ID /"(" arg [/"," arg] /")"
+@arg : ID | INT

beautiful-racket-demo/simplex-demo/main.rkt

@@ -0,0 +1,35 @@
+#lang br/quicklang
+(require brag/support "grammar.rkt")
+(provide (all-defined-out) #%module-begin)
+
+(module+ reader
+  (provide read-syntax))
+
+(define-lex-abbrev reserved-toks
+  (:or "fun" "(" ")" "=" "+" ","))
+
+(define lex
+  (lexer
+   [whitespace (lex input-port)]
+   [reserved-toks lexeme]
+   [alphabetic (token 'ID (string->symbol lexeme))]
+   [(:+ (char-set "0123456789")) (token 'INT (string->number lexeme))]))
+
+(define-macro top #'begin)
+
+(define-macro (func-def ID ARGIDS EXPR)
+  #'(define ID (λ ARGIDS EXPR)))
+
+(define-macro-cases expr
+  [(_ LEFT "+" RIGHT) #'(+ LEFT RIGHT)]
+  [(_ OTHER) #'OTHER])
+
+(define-macro (func-app ID ARG ...)
+  #'(ID ARG ...))
+
+(define (read-syntax src ip)
+  (define pt (parse (λ () (lex ip))))
+  (strip-context
+   (with-syntax ([PT pt])
+     #'(module mod-name simplex-demo
+         PT))))

beautiful-racket-demo/simplex-demo/test.rkt

@@ -0,0 +1,4 @@
+#lang simplex-demo
+fun f(x,y) = x + y 
+fun g(z) = f(z,z)
+g(10)

beautiful-racket-demo/taco-compiler-demo/main.rkt

@@ -0,0 +1,23 @@
+#lang br/quicklang
+
+(module+ reader
+  (provide read-syntax))
+
+(define (tokenize ip)
+  (for/list ([tok (in-port read-char ip)])
+            tok))
+
+(define (parse-char c)
+  (define int (modulo (char->integer c) 128))
+  (for/list ([bit (in-range 7)])
+            (if (bitwise-bit-set? int bit)
+                'taco
+                null)))
+
+(define (read-syntax src ip)
+  (define toks (tokenize ip))
+  (define parse-tree (map parse-char toks))
+  (strip-context
+   (with-syntax ([(PARSED-CHAR ...) parse-tree])
+     #'(module tacofied racket
+         (for-each displayln '(PARSED-CHAR ...))))))

beautiful-racket-demo/taco-compiler-demo/test.rkt

@@ -0,0 +1,4 @@
+#lang taco-compiler-demo
+
+"hello world"
+(+ 1 (* 2 (- 3)))

beautiful-racket-demo/taco-decompiler-demo/main.rkt

@@ -0,0 +1,23 @@
+#lang br/quicklang
+
+(module+ reader
+  (provide read-syntax))
+
+(define (tokenize ip)
+  (for/list ([tok (in-port read ip)])
+            tok))
+
+(define (parse tok)
+  (integer->char
+   (for/sum ([val (in-list tok)]
+             [power (in-naturals)]
+             #:when (eq? val 'taco))
+            (expt 2 power))))
+
+(define (read-syntax src ip)
+  (define toks (tokenize ip))
+  (define parse-tree (map parse toks))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module untaco racket
+         (display (list->string 'PT))))))

beautiful-racket-demo/taco-decompiler-demo/run.rkt

@@ -0,0 +1,27 @@
+#lang br/quicklang
+
+(module+ reader
+  (provide read-syntax))
+
+(define (tokenize ip)
+  (for/list ([tok (in-port read ip)])
+            tok))
+
+(define (parse tok)
+  (integer->char
+   (for/sum ([val (in-list tok)]
+             [power (in-naturals)]
+             #:when (eq? val 'taco))
+            (expt 2 power))))
+
+(define (read-syntax src ip)
+  (define toks (tokenize ip))
+  (define parse-tree (map parse toks))
+  (define src-string (list->string parse-tree))
+  (define racket-toks
+    (for/list ([tok (in-port read (open-input-string src-string))])
+              tok))
+  (strip-context
+   (with-syntax ([RACKET-TOKS racket-toks])
+     #'(module untaco racket
+         . RACKET-TOKS))))

beautiful-racket-demo/taco-decompiler-demo/test.rkt

@@ -0,0 +1,34 @@
+#lang taco-decompiler-demo
+(() taco () taco () () ())
+(() taco () taco () () ())
+(() taco () () () taco ())
+(() () () taco () taco taco)
+(taco () taco () () taco taco)
+(() () taco taco () taco taco)
+(() () taco taco () taco taco)
+(taco taco taco taco () taco taco)
+(() () () () () taco ())
+(taco taco taco () taco taco taco)
+(taco taco taco taco () taco taco)
+(() taco () () taco taco taco)
+(() () taco taco () taco taco)
+(() () taco () () taco taco)
+(() taco () () () taco ())
+(() taco () taco () () ())
+(() () () taco () taco ())
+(taco taco () taco () taco ())
+(() () () () () taco ())
+(taco () () () taco taco ())
+(() () () () () taco ())
+(() () () taco () taco ())
+(() taco () taco () taco ())
+(() () () () () taco ())
+(() taco () () taco taco ())
+(() () () () () taco ())
+(() () () taco () taco ())
+(taco () taco taco () taco ())
+(() () () () () taco ())
+(taco taco () () taco taco ())
+(taco () () taco () taco ())
+(taco () () taco () taco ())
+(taco () () taco () taco ())

beautiful-racket-demo/taco-victory-demo/grammar.rkt

@@ -0,0 +1,5 @@
+#lang brag
+taco-program : taco-leaf*
+taco-leaf : (taco | not-a-taco){7}
+taco : /"%"
+not-a-taco : /"#$"

beautiful-racket-demo/taco-victory-demo/main.rkt

@@ -0,0 +1,31 @@
+#lang br/quicklang
+(require brag/support "grammar.rkt")
+(provide (all-from-out br/quicklang) (all-defined-out))
+
+(module+ reader
+  (provide read-syntax))
+
+(define lex
+  (lexer
+   ["#$" lexeme]
+   ["%" lexeme]
+   [any-char (lex input-port)]))
+
+(define (taco-program . pieces) pieces)
+
+(define (taco-leaf . pieces)
+  (integer->char
+   (for/sum ([bit (in-list pieces)]
+             [pow (in-naturals)])
+            (* bit (expt 2 pow)))))
+
+(define (taco) 1)
+
+(define (not-a-taco) 0)
+
+(define (read-syntax src ip)
+  (define parse-tree (parse (λ () (lex ip))))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module vic taco-victory-demo
+         (display (apply string PT))))))

beautiful-racket-demo/taco-victory-demo/test.rkt

@@ -0,0 +1,2 @@
+#lang taco-victory-demo
+##$%#$%#$#$#$$##$%#$%#$#$#$$##$%#$#$#$%#$$##$#$#$%#$%%$#%#$%#$#$%%$##$#$%%#$%%$##$#$%%#$%%$#%%%%#$%%$##$#$#$#$#$%#$$#%%%#$%%%$#%%%%#$%%$##$%#$#$%%%$##$#$%%#$%%$##$#$%#$#$%%$##$%#$#$#$%#$$##$%#$%#$#$#$$##$#$#$%#$%#$$#%%#$%#$%#$$##$#$#$#$#$%#$$#%#$#$#$%%#$$##$#$#$#$#$%#$$##$#$#$%#$%#$$##$%#$%#$%#$$##$#$#$#$#$%#$$##$%#$#$%%#$$##$#$#$#$#$%#$$##$#$#$%#$%#$$#%#$%%#$%#$$##$#$#$#$#$%#$$#%%#$#$%%#$$#%#$#$%#$%#$$#%#$#$%#$%#$$#%#$#$%#$%#$$

beautiful-racket-demo/tacogram-demo/grammar.rkt

@@ -0,0 +1,7 @@
+#lang brag
+taco-program : /"\n"* taco-leaf* /"\n"*
+taco-leaf : /left-paren (taco | not-a-taco){7} /right-paren
+taco : /"%"
+not-a-taco : /left-paren /right-paren
+left-paren : "#"
+right-paren : "$"

beautiful-racket-demo/tacogram-demo/main.rkt

@@ -0,0 +1,24 @@
+#lang br/quicklang
+(require "grammar.rkt")
+
+(module+ reader
+  (provide read-syntax))
+
+(define (tokenize ip)
+  (for/list ([tok (in-port read-char ip)])
+            tok))
+
+(define (leaf->char taco-leaf)
+  (integer->char
+   (for/sum ([val (in-list (cdr taco-leaf))]
+             [power (in-naturals)]
+             #:when (equal? val '(taco)))
+            (expt 2 power))))
+
+(define (read-syntax src ip)
+  (define parse-tree (parse-to-datum (tokenize ip)))
+  (define taco-branches (cdr parse-tree))
+  (strip-context
+   (with-syntax ([CHARS (map leaf->char taco-branches)])
+     #'(module untaco racket
+         (display (list->string 'CHARS))))))

beautiful-racket-demo/tacogram-demo/test.rkt

@@ -0,0 +1,2 @@
+#lang tacogram-demo
+##$%#$%#$#$#$$##$%#$%#$#$#$$##$%#$#$#$%#$$##$#$#$%#$%%$#%#$%#$#$%%$##$#$%%#$%%$##$#$%%#$%%$#%%%%#$%%$##$#$#$#$#$%#$$#%%%#$%%%$#%%%%#$%%$##$%#$#$%%%$##$#$%%#$%%$##$#$%#$#$%%$##$%#$#$#$%#$$##$%#$%#$#$#$$##$#$#$%#$%#$$#%%#$%#$%#$$##$#$#$#$#$%#$$#%#$#$#$%%#$$##$#$#$#$#$%#$$##$#$#$%#$%#$$##$%#$%#$%#$$##$#$#$#$#$%#$$##$%#$#$%%#$$##$#$#$#$#$%#$$##$#$#$%#$%#$$#%#$%%#$%#$$##$#$#$#$#$%#$$#%%#$#$%%#$$#%#$#$%#$%#$$#%#$#$%#$%#$$#%#$#$%#$%#$$

beautiful-racket-demo/tacopocalypse-demo/main.rkt

@@ -0,0 +1,33 @@
+#lang br/quicklang
+(require brag/support racket/sequence)
+
+(module+ reader
+  (provide read-syntax))
+
+(define lex
+  (lexer
+   ["#$" null]
+   ["%" 'taco]
+   [any-char (lex input-port)]))
+
+(define (tokenize ip)
+  (define toklets
+    (for/list ([toklet (in-port lex ip)])
+              toklet))
+  (for/list ([tok (in-slice 7 toklets)])
+            tok))
+
+(define (parse taco-rec-tok)
+  (integer->char
+   (for/sum ([val (in-list taco-rec-tok)]
+             [power (in-naturals)]
+             #:when (eq? val 'taco))
+            (expt 2 power))))
+
+(define (read-syntax src ip)
+  (define toks (tokenize ip))
+  (define parse-tree (map parse toks))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module untaco racket
+         (display (list->string 'PT))))))

beautiful-racket-demo/tacopocalypse-demo/test.rkt

@@ -0,0 +1,2 @@
+#lang tacopocalypse-demo
+##$%#$%#$#$#$$##$%#$%#$#$#$$##$%#$#$#$%#$$##$#$#$%#$%%$#%#$%#$#$%%$##$#$%%#$%%$##$#$%%#$%%$#%%%%#$%%$##$#$#$#$#$%#$$#%%%#$%%%$#%%%%#$%%$##$%#$#$%%%$##$#$%%#$%%$##$#$%#$#$%%$##$%#$#$#$%#$$##$%#$%#$#$#$$##$#$#$%#$%#$$#%%#$%#$%#$$##$#$#$#$#$%#$$#%#$#$#$%%#$$##$#$#$#$#$%#$$##$#$#$%#$%#$$##$%#$%#$%#$$##$#$#$#$#$%#$$##$%#$#$%%#$$##$#$#$#$#$%#$$##$#$#$%#$%#$$#%#$%%#$%#$$##$#$#$#$#$%#$$#%%#$#$%%#$$#%#$#$%#$%#$$#%#$#$%#$%#$$#%#$#$%#$%#$$

beautiful-racket-demo/tacopocalypse-prep/main.rkt

@@ -0,0 +1,23 @@
+#lang br/quicklang
+(require brag/support racket/sequence)
+
+(module+ reader
+  (provide read-syntax))
+
+(define taco-lexer
+  (lexer
+   ["(" "#"]
+   [")" "$"]
+   ["taco" "%"]
+   [any-char (taco-lexer input-port)]))
+  
+(define (read-syntax src port)
+  (define toks (for/list ([tok (in-port taco-lexer port)])
+                         tok))
+  (define parse-tree (string-join toks ""))
+  
+  ;; print result
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module untaco racket
+         (display PT)))))

beautiful-racket-demo/tacopocalypse-prep/test.rkt

@@ -0,0 +1,34 @@
+#lang tacopocalypse-prep
+(() taco () taco () () ())
+(() taco () taco () () ())
+(() taco () () () taco ())
+(() () () taco () taco taco)
+(taco () taco () () taco taco)
+(() () taco taco () taco taco)
+(() () taco taco () taco taco)
+(taco taco taco taco () taco taco)
+(() () () () () taco ())
+(taco taco taco () taco taco taco)
+(taco taco taco taco () taco taco)
+(() taco () () taco taco taco)
+(() () taco taco () taco taco)
+(() () taco () () taco taco)
+(() taco () () () taco ())
+(() taco () taco () () ())
+(() () () taco () taco ())
+(taco taco () taco () taco ())
+(() () () () () taco ())
+(taco () () () taco taco ())
+(() () () () () taco ())
+(() () () taco () taco ())
+(() taco () taco () taco ())
+(() () () () () taco ())
+(() taco () () taco taco ())
+(() () () () () taco ())
+(() () () taco () taco ())
+(taco () taco taco () taco ())
+(() () () () () taco ())
+(taco taco () () taco taco ())
+(taco () () taco () taco ())
+(taco () () taco () taco ())
+(taco () () taco () taco ())

beautiful-racket-demo/xmlish-demo/grammar.rkt

@@ -0,0 +1,19 @@
+#lang brag
+
+top : @content
+content : (tagged-element | /comment | string | sp)*
+
+tagged-element : /"<" /sp? identifier attrs /sp? (short | full)
+@short : /"/>"
+@full : /">" content /"</" /sp? identifier /sp? /">"
+
+attrs : [attr] (/sp attr)*
+attr : identifier /sp? /"=" /sp? /"\"" string /"\""
+
+comment	: "<!--" (string | sp)* "-->"
+
+string : char+
+identifier : ALPHANUMERIC [@string]
+
+@sp : SP
+@char : ALPHANUMERIC | OTHER | AMP | LT | GT | "=" | "\""

beautiful-racket-demo/xmlish-demo/main.rkt

@@ -0,0 +1,46 @@
+#lang br/quicklang
+(require brag/support "grammar.rkt" xml)
+(provide (all-from-out br/quicklang) (all-defined-out) xexpr?)
+
+(module+ reader
+  (provide read-syntax))
+
+(define-lex-abbrev xml-reserved
+  (:or "<" "/>" "</" ">" "<!--" "-->" "=" "\""))
+
+(define lex
+  (lexer
+   [(:+ whitespace) (token 'SP " ")]
+   ["&amp;" (token 'AMP "&")]
+   ["&lt;" (token 'LT "<")]
+   ["&gt;" (token 'GT ">")]
+   [xml-reserved lexeme]
+   [(:or alphabetic numeric) (token 'ALPHANUMERIC lexeme)]
+   [any-char (token 'OTHER lexeme)]))
+
+(define (top . contents) `(root ,@contents))
+(define (content . xs) xs)
+
+(define-cases tagged-element
+  [(_ id attrs) (list id attrs)]
+  [(_ id attrs contents id-end)
+   (unless (eq? id id-end)
+     (raise-argument-error 'tagged-element "matched tags" (list id id-end)))
+   (list* id attrs contents)])
+
+(define (attrs . attr-list) attr-list)
+(define (attr id value) (list id value))
+
+(define (string . strs) (string-join strs ""))
+(define (identifier . strs)
+  (string->symbol (apply string strs)))
+
+(define (read-syntax src ip)
+  (define parse-tree (parse (λ () (lex ip))))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module mel xmlish-demo
+         (println PT)
+         (displayln (if (xexpr? PT)
+                        "YES, it's an X-expression"
+                        "NO, it's not an X-expression"))))))

beautiful-racket-demo/xmlish-demo/test.rkt

@@ -0,0 +1,10 @@
+#lang xmlish-demo
+
+hello world
+<br />
+<div foo="bar" />
+< div ></ div >
+<div foo="bar" zim="zam">hello world</div>
+<!-- comment -->
+< p:foo foo="bar" zim= "42" >Hell = o <em>World</em> 42 "-!=" &amp; &gt; &lt; </ p:foo>
+