rearrangements

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

@@ -27,7 +27,6 @@
 (define ptr 0)
 
 (define (current-byte) (vector-ref arr ptr))
-
 (define (set-current-byte! val) (vector-set! arr ptr val))
 
 (define (gt) (set! ptr (add1 ptr)))

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

@@ -0,0 +1,61 @@
+#lang br/quicklang
+ 
+(define-macro (bf-module-begin PARSE-TREE)
+  #'(#%module-begin
+     PARSE-TREE))
+(provide (rename-out [bf-module-begin #%module-begin]))
+
+(define (fold-funcs apl bf-funcs)
+  (for/fold ([current-apl apl])
+            ([bf-func (in-list bf-funcs)])
+    (apply bf-func current-apl)))
+
+(define-macro (bf-program OP-OR-LOOP-ARG ...)
+  #'(begin
+      (define first-apl (list (make-vector 30000 0) 0))
+      (void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...)))))
+(provide bf-program)
+
+(define-macro (loop "[" OP-OR-LOOP-ARG ... "]")
+  #'(lambda (arr ptr)
+      (for/fold ([current-apl (list arr ptr)])
+                ([i (in-naturals)]
+                 #:break (zero? (apply current-byte
+                                       current-apl)))
+        (fold-funcs current-apl (list OP-OR-LOOP-ARG ...)))))
+(provide loop)
+
+(define-macro-cases op
+  [(op ">") #'gt]
+  [(op "<") #'lt]
+  [(op "+") #'plus]
+  [(op "-") #'minus]
+  [(op ".") #'period]
+  [(op ",") #'comma])
+(provide op)
+
+(define (current-byte arr ptr) (vector-ref arr ptr))
+
+(define (set-current-byte arr ptr val)
+  (define new-arr (vector-copy arr))
+  (vector-set! new-arr ptr val)
+  new-arr)
+
+(define (gt arr ptr) (list arr (add1 ptr)))
+(define (lt arr ptr) (list arr (sub1 ptr)))
+
+(define (plus arr ptr)
+  (list (set-current-byte arr ptr (add1 (current-byte arr ptr)))
+        ptr))
+
+(define (minus arr ptr)
+  (list (set-current-byte arr ptr (sub1 (current-byte arr ptr)))
+        ptr))
+
+(define (period arr ptr)
+  (write-byte (current-byte arr ptr))
+  (list arr ptr))
+
+(define (comma arr ptr)
+  (list (set-current-byte arr ptr (read-byte)) ptr))
+

beautiful-racket-demo/bf-demo/parser-tester.rkt

@@ -0,0 +1,3 @@
+#lang br
+(require "parser.rkt")
+(parse-tree "++++-+++-++-++[>++++-+++-++-++<-]>.")

beautiful-racket-demo/bf-demo/parser.rkt

@@ -1,4 +1,4 @@
 #lang brag
 bf-program : (op | loop)*
-op : ">" | "<" | "+" | "-" | "." | ","
-loop : "[" (op | loop)* "]"
+op         : ">" | "<" | "+" | "-" | "." | ","
+loop       : "[" (op | loop)* "]"

beautiful-racket-demo/bf-demo/reader.rkt

@@ -3,7 +3,7 @@
 
 (define (read-syntax path port)
   (define parse-tree (parse path (tokenize port)))
-  (define module-datum `(module bf-mod bf/expander
+  (define module-datum `(module bf-mod bf-demo/expander
                           ,parse-tree))
   (datum->syntax #f module-datum))
 (provide read-syntax)

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

@@ -0,0 +1,6 @@
+#lang reader "funstacker.rkt"
+4
+8
++
+3
+*

beautiful-racket-demo/funstacker-demo/funstacker.rkt

@@ -3,7 +3,7 @@
 (define (read-syntax path port)
   (define args (port->lines port))
   (define arg-datums (format-datums '~a args))
-  (define module-datum `(module stacker-mod br/demo/funstacker
+  (define module-datum `(module stacker-mod "funstacker.rkt"
                           (handle-args ,@arg-datums)))
   (datum->syntax #f module-datum))
 (provide read-syntax)
@@ -25,7 +25,3 @@
 (provide handle-args)
 
 (provide + *)
-
-(module+ test 
-  (require rackunit)
-  (check-equal? (with-output-to-string (λ () (dynamic-require "funstacker-test.rkt" #f))) "36"))

beautiful-racket-demo/funstacker-test.rkt

@@ -1,8 +0,0 @@
-#lang reader br/demo/funstacker
-4
-8
-
-+
-3
-
-*

beautiful-racket-demo/jsonic-demo-2/colorer.rkt

@@ -1,12 +1,11 @@
 #lang br
-(require brag/support
-         syntax-color/racket-lexer)
+(require brag/support syntax-color/racket-lexer racket/contract)
 
 (define in-racket-expr? #f)
 
 (define/contract (color-jsonic port)
-  (input-port? . -> .
-               (values (or/c string? eof-object?)
+  (input-port? . -> . (values
+                       (or/c string? eof-object?)
                        symbol?
                        (or/c symbol? #f)
                        (or/c exact-positive-integer? #f)
@@ -23,9 +22,11 @@
              (values lexeme 'parenthesis '|)|
                      (pos lexeme-start) (pos lexeme-end)))]
      [(from/to "//" "\n")
-      (values lexeme 'comment #f (pos lexeme-start) (pos lexeme-end))]
+      (values lexeme 'comment #f
+              (pos lexeme-start) (pos lexeme-end))]
      [any-char
-      (values lexeme 'string #f (pos lexeme-start) (pos lexeme-end))]))
+      (values lexeme 'string #f
+              (pos lexeme-start) (pos lexeme-end))]))
   (if (and in-racket-expr?
            (not (equal? (peek-string 2 0 port) "$@")))
       (racket-lexer port)
@@ -34,5 +35,6 @@
 
 (module+ test
   (require rackunit)
-  (check-equal? (values->list (color-jsonic (open-input-string "x")))
+  (check-equal? (values->list
+                 (color-jsonic (open-input-string "x")))
                 (list "x" 'string #f 1 2)))

beautiful-racket-demo/jsonic-demo-2/indenter.rkt

@@ -1,14 +1,11 @@
 #lang br
-(require br/indent racket/gui/base)
+(require br/indent racket/gui/base racket/contract)
 (provide indent-jsonic)
 
 (define indent-width 2)
 (define (left-bracket? c) (member c (list #\{ #\[)))
 (define (right-bracket? c) (member c (list #\} #\])))
 
-;; if this line begins with } or ], outdent.
-;; if last line begins with { or [, indent.
-;; otherwise use previous indent
 (define/contract (indent-jsonic tbox [posn 0])
   ((is-a?/c text%) exact-nonnegative-integer?  . -> .
                    (or/c exact-nonnegative-integer? #f))

beautiful-racket-demo/jsonic-demo-2/jsonic-test.rkt

@@ -1,4 +1,4 @@
-#lang br/demo/jsonic-2
+#lang jsonic-demo-2
 // a line comment
 [
   @$ 'null $@,

beautiful-racket-demo/jsonic-demo-2/main.rkt

@@ -6,11 +6,11 @@
     (define (handle-query key default)
       (case key
         [(color-lexer)
-         (dynamic-require 'br/demo/jsonic-2/colorer 'color-jsonic)]
+         (dynamic-require 'jsonic-demo-2/colorer 'color-jsonic)]
         [(drracket:indentation)
-         (dynamic-require 'br/demo/jsonic-2/indenter 'indent-jsonic)]
+         (dynamic-require 'jsonic-demo-2/indenter 'indent-jsonic)]
         [(drracket:toolbar-buttons)
-         (dynamic-require 'br/demo/jsonic-2/buttons 'button-list)]
+         (dynamic-require 'jsonic-demo-2/buttons 'button-list)]
         [else default]))
     handle-query))
 

beautiful-racket-demo/jsonic-demo-2/parser-test.rkt

@@ -1,6 +1,5 @@
 #lang br
-(require "parser.rkt" "tokenizer.rkt"
-         brag/support rackunit)
+(require "parser.rkt" "tokenizer.rkt" brag/support rackunit)
 
 (check-equal?
  (parse-tree (apply-tokenizer tokenize "// line commment\n"))

beautiful-racket-demo/jsonic-demo-2/reader.rkt

@@ -1,10 +1,10 @@
 #lang br/quicklang
-(require "tokenizer.rkt" "parser.rkt")
+(require "tokenizer.rkt" "parser.rkt" racket/contract)
 
 (define/contract (read-syntax path port)
   (any/c input-port? . -> . syntax?)
   (define parse-tree (parse path (tokenize port)))
-  (define module-datum `(module jsonic-module br/demo/jsonic-2/expander
+  (define module-datum `(module jsonic-module jsonic-demo-2/expander
                           ,parse-tree))
   (datum->syntax #f module-datum))
 (provide read-syntax)

beautiful-racket-demo/jsonic-demo-2/tokenizer.rkt

@@ -1,5 +1,5 @@
 #lang br/quicklang
-(require brag/support)
+(require brag/support racket/contract)
 
 (module+ test
   (require rackunit))

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

@@ -1,5 +1,6 @@
 #lang br/quicklang
 (require json)
+
 (define-macro (js-module-begin PARSE-TREE)
   #'(#%module-begin
      (define result-string PARSE-TREE)

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

@@ -1,4 +1,4 @@
-#lang br/demo/jsonic
+#lang jsonic-demo
 // a line comment
 [
     @$ 'null $@,

beautiful-racket-demo/jsonic-demo/reader.rkt

@@ -1,8 +1,9 @@
 #lang br/quicklang
 (require "tokenizer.rkt" "parser.rkt")
+
 (define (read-syntax path port)
   (define parse-tree (parse path (tokenize port)))
-  (define module-datum `(module jsonic-module br/demo/jsonic/expander
+  (define module-datum `(module jsonic-module jsonic-demo/expander
                           ,parse-tree))
   (datum->syntax #f module-datum))
 (provide read-syntax)

beautiful-racket-demo/jsonic-demo/tokenizer.rkt

@@ -1,5 +1,6 @@
 #lang br/quicklang
 (require brag/support)
+
 (define (tokenize port)
   (define (next-token)
     (define our-lexer

beautiful-racket-demo/stackerizer-demo/stackerizer.rkt

@@ -14,14 +14,4 @@
          #'(list 'OP FIRST (OP NEXT (... ...)))]) 
       ...))
 
-(define-ops + *)
-
-(module+ test 
-  (require rackunit)
-  (check-equal? (with-output-to-string (λ () (dynamic-require "stackerizer-test.rkt" #f)))
-                "4
-8
-+
-3
-*
-"))
+(define-ops + *)

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

@@ -8,7 +8,7 @@
     (for/list ([wire-str (in-lines port)])
       (format-datum '(wire ~a) wire-str)))
   (strip-bindings
-   #`(module wires-mod br/demo/wires/main
+   #`(module wires-mod wires-demo/main
        #,@wire-datums)))
 
 (provide #%module-begin)

beautiful-racket-demo/wires-demo/puzzle.rkt

@@ -1,4 +1,4 @@
-#lang br/demo/wires
+#lang wires-demo
 bn RSHIFT 2 -> bo
 lf RSHIFT 1 -> ly
 fo RSHIFT 3 -> fq

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

@@ -1,4 +1,4 @@
-#lang br/demo/wires
+#lang wires-demo
 x AND y -> d
 x OR y -> e
 x LSHIFT 2 -> f

beautiful-racket-lib/br/main.rkt

@@ -1,9 +1,9 @@
 #lang racket/base
-(require racket/provide racket/list racket/string racket/format racket/match racket/port racket/contract racket/function
+(require racket/provide racket/list racket/string racket/format racket/match racket/port  racket/function
          br/define br/syntax br/datum br/debug br/cond racket/class racket/vector br/reader-utils
          (for-syntax racket/base racket/syntax br/syntax br/debug br/define br/datum))
 (provide (all-from-out racket/base)
-         (all-from-out racket/list racket/string racket/format racket/match racket/port racket/contract racket/function
+         (all-from-out racket/list racket/string racket/format racket/match racket/port racket/function
                        br/syntax br/datum br/debug br/cond racket/class racket/vector br/define br/reader-utils)
          (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug br/datum))
          (for-syntax caller-stx with-shared-id)) ; from br/define