move files to `beautiful-racket-lib`

br/conditional.rkt

@@ -1,15 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base))
-(provide (all-defined-out))
-
-(define-syntax-rule (until cond expr ...)
-  (let loop ()
-    (unless cond
-      expr ...
-      (loop))))
-
-(define-syntax-rule (while cond expr ...)
-  (let loop ()
-    (when cond
-      expr ...
-      (loop))))

br/datum.rkt

@@ -1,39 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base br/syntax) br/define)
-(provide (all-defined-out))
-
-;; read "foo bar" the same way as "(foo bar)" 
-;; other "bar" is dropped, which is too astonishing
-(define (string->datum str)
-  (let ([result (read (open-input-string (format "(~a)" str)))])
-    (if (= (length result) 1)
-        (car result)
-        result)))
-
-#;(define-syntax format-datum
-    (λ(stx)
-      (syntax-case stx (quote datum)
-        [(_ (quote <datum-template>) <arg> ...)
-         #'(format-datum (datum <datum-template>) <arg> ...)]
-        [(_ (datum datum-template) <arg> ...)
-         (syntax-let ([#'format-string (format "~a" (syntax->datum #'datum-template))])
-                     #'(string->datum (apply format format-string (map (λ(arg) (if (syntax? arg)
-                                                                                   (syntax->datum arg)
-                                                                                   arg)) (list <arg> ...)))))])))
-
-(define (format-datum datum-template . args)
-  (string->datum (apply format (format "~a" datum-template) (map (λ(arg) (if (syntax? arg)
-                                                                             (syntax->datum arg)
-                                                                             arg)) args))))
-
-(module+ test
-  (require rackunit syntax/datum)
-  (check-equal? (string->datum "foo") 'foo)
-  (check-equal? (string->datum "(foo bar)") '(foo bar))
-  (check-equal? (string->datum "foo bar") '(foo bar))
-  (check-equal? (string->datum "42") 42)
-  (check-equal? (format-datum '(~a-bar-~a) "foo" "zam") '(foo-bar-zam))
-  (check-equal? (format-datum '(~a-bar-~a) #'foo #'zam) '(foo-bar-zam))
-  (check-equal? (format-datum (datum (~a-bar-~a)) "foo" "zam") '(foo-bar-zam))
-  (check-equal? (format-datum '~a "foo") 'foo)
-  (check-equal? (format-datum (datum ~a) "foo") 'foo))

br/debug.rkt

@@ -1,17 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base racket/syntax))
-(provide (all-defined-out))
-
-(define-syntax (report stx)
-  (syntax-case stx ()
-    [(_ expr) #'(report expr expr)]
-    [(_ expr name)
-     #'(let ([expr-result expr]) 
-         (eprintf "~a = ~v\n" 'name expr-result)
-         expr-result)]))
-
-(define-syntax-rule (define-multi-version multi-name name)
-  (define-syntax-rule (multi-name x (... ...))
-    (begin (name x) (... ...))))
-
-(define-multi-version report* report)

br/define.rkt

@@ -1,122 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base syntax/parse racket/syntax syntax/datum syntax/strip-context))
-(provide (all-defined-out))
-
-
-(define-syntax-rule (br:debug-define (syntax (id pat-arg ... . rest-arg)) body-exp)
-  (br:define #'(id pat-arg ... . rest-arg)
-             #`(begin
-                 (for-each displayln
-                           (list
-                            (format "input pattern = #'~a" '#,'(id pat-arg ... . rest-arg))
-                            (format "output pattern = #'~a" (cadr '#,'body-exp))
-                            (format "invoked as = ~a" (syntax->datum #'(id pat-arg ... . rest-arg)))
-                            (format "expanded as = ~a" '#,(syntax->datum body-exp))
-                            (format "evaluated as = ~a" #,body-exp)))
-                 #,body-exp)))
-
-
-(module+ test
-  (require rackunit racket/port)
-  (parameterize ([current-output-port (open-output-nowhere)])
-    (check-equal? (let ()
-                    (br:debug-define #'(foo <x> <y> <z>)
-                                     #'(apply + (list <x> <y> <z>)))
-                    (foo 1 2 3)) 6)  
-    (check-equal? (let ()
-                    (br:debug-define #'(foo <x> ...) #'(apply * (list <x> ...)))
-                    (foo 10 11 12)) 1320)))
-
-
-(define-syntax (br:define stx)
-  (define-syntax-class syntaxed-id
-    #:literals (syntax)
-    #:description "id in syntaxed form"
-    (pattern (syntax name:id)))
-
-  (define-syntax-class syntaxed-thing
-    #:literals (syntax)
-    #:description "some datum in syntaxed form"
-    (pattern (syntax thing:expr)))
-  
-  (syntax-parse stx
-    #:literals (syntax)
-    [(_ (syntax (id pat-arg ... . rest-arg)) body ...) ; (define #'(foo arg) #'(+ arg arg))
-     #'(define-syntax id (λ (stx)
-                           (define result
-                             (syntax-case stx ()
-                               [(_ pat-arg ... . rest-arg) body ...]))
-                           (if (not (syntax? result))
-                               (datum->syntax stx result)
-                               result)))]
-    
-    [(_ sid:syntaxed-id sid2:syntaxed-id) ; (define #'f1 #'f2)
-     #'(define-syntax sid.name (make-rename-transformer sid2))]
-
-    [(_ sid:syntaxed-id sid2:syntaxed-thing) ; (define #'f1 #'42)
-     #'(define-syntax sid.name (λ (stx) sid2))]
-    
-    [(_ (sid:syntaxed-id stx-arg ...) expr ...)  ; (define (#'f1 stx) expr ...)
-     (raise-syntax-error 'define "definition of a syntax transformer must use lambda notation, because otherwise it's too easy to confuse the compile-time shape and the run-time shape" (syntax->datum #'sid.name))]
-    
-    [(_ sid:syntaxed-id (λ (stx-arg ...) expr ...)) ; (define #'f1 (λ(stx) expr ...)
-     #:fail-when (not (= (length (syntax->datum #'(stx-arg ...))) 1))
-     (raise-syntax-error 'define "did not get exactly one argument for macro" (syntax->datum #'(stx-arg ...)))
-     #'(define-syntax (sid.name stx-arg ...) expr ...)]
-    
-    [(_ args ...) #'(define args ...)]))
-
-(module+ test
-  (require rackunit)
-  (br:define #'plus (λ(stx) #'+))
-  (br:define #'plusser #'plus)
-  (br:define #'(times arg) #'(* arg arg))
-  (br:define #'timeser #'times)
-  (br:define #'fortytwo #'42)
-  (check-equal? (plus 42) +)
-  (check-equal? plusser +)
-  (check-equal? (plusser 42) +)
-  (check-equal? (times 10) 100)
-  (check-equal? (timeser 12) 144)
-  (check-equal? (let ()
-                  (br:define #'(foo x)
-                             (with-syntax ([zam +])
-                               #'(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) #'*)))
-  (check-equal? fortytwo 42))
-
-
-;; todo: support `else` case
-(define-syntax (br:define-cases stx)
-  (syntax-parse stx
-    #:literals (syntax)
-    ; (define-cases #'foo [#'(_ arg) #'(+ arg arg)] [#'(_ 42 bar) #'42] ...)
-    [(_ (syntax top-id) [(syntax (_ pat-arg ... . rest-arg)) body ...] ...) 
-     #'(define-syntax top-id (λ (stx)
-                               (define result
-                                 (syntax-case stx ()
-                                   [(_ pat-arg ... . rest-arg) body ...] ...))
-                               (if (not (syntax? result))
-                                   (datum->syntax stx result)
-                                   result)))]
-    
-    [(_ top-id [(_ pat-arg ... . rest-arg) body ...] ...)
-     #'(define top-id
-         (case-lambda
-           [(pat-arg ... . rest-arg) body ...] ...))]))
-
-(module+ test
-  (br:define-cases #'op
-    [#'(_ "+") #''got-plus]
-    [#'(_ arg) #''got-something-else])
-
-  (check-equal? (op "+") 'got-plus)
-  (check-equal? (op 42) 'got-something-else)
-  
-  (br:define-cases f
-    [(_ arg) (add1 arg)]
-    [(_ arg1 arg2) (+ arg1 arg2)])
-
-  (check-equal? (f 42) 43)
-  (check-equal? (f 42 5) 47))

br/eopl.rkt

@@ -1,96 +0,0 @@
-#lang br
-(require rackunit racket/struct (for-syntax br/datum sugar/debug))
-(provide define-datatype cases occurs-free?)
-
-#;(begin
-    (struct lc-exp () #:transparent)
-    
-    (struct var-exp lc-exp (var) #:transparent
-      #:guard (λ(var name)
-                (unless (symbol? var)
-                  (error name (format "arg ~a not ~a" var 'symbol?)))
-                (values var)))
-    
-    (struct lambda-exp lc-exp (bound-var body) #:transparent
-      #:guard (λ(bound-var body name)
-                (unless (symbol? bound-var)
-                  (error name (format "arg ~a not ~a" bound-var 'symbol?)))
-                (unless (lc-exp? body)
-                  (error name (format "arg ~a not ~a" body 'lc-exp?)))
-                (values bound-var body)))
-    
-    (struct app-exp lc-exp (rator rand) #:transparent
-      #:guard (λ(rator rand name)
-                (unless (lc-exp? rator)
-                  (error name (format "arg ~a not ~a" rator 'lc-exp?)))
-                (unless (lc-exp? rand)
-                  (error name (format "arg ~a not ~a" rand 'lc-exp?)))
-                (values rator rand))))
-
-
-(define #'(define-datatype <base-type> <base-type-predicate?>
-            (<subtype> [<field> <field-predicate?>] ...) ...)
-  #'(begin
-      (struct <base-type> () #:transparent #:mutable)
-      (struct <subtype> <base-type> (<field> ...) #:transparent #:mutable
-        #:guard (λ(<field> ... name)
-                  (unless (<field-predicate?> <field>)
-                    (error name (format "arg ~a is not ~a" <field> '<field-predicate?>))) ...
-                  (values <field> ...))) ...))
-
-
-(define-datatype lc-exp lc-exp?
-  (var-exp [var symbol?])
-  (lambda-exp [bound-var symbol?] [body lc-exp?])
-  (app-exp [rator lc-exp?] [rand lc-exp?]))
-
-
-#;(define (occurs-free? search-var exp)
-    (cond
-      [(var-exp? exp) (let ([var (var-exp-var exp)])
-                        (eqv? var  search-var))]
-      [(lambda-exp? exp) (let ([bound-var (lambda-exp-bound-var exp)]
-                               [body (lambda-exp-body exp)])
-                           (and (not (eqv? search-var bound-var))
-                                (occurs-free? search-var body)))]
-      [(app-exp? exp) (let ([rator (app-exp-rator exp)]
-                            [rand (app-exp-rand exp)])
-                        (or
-                         (occurs-free? search-var rator)
-                         (occurs-free? search-var rand)))]))
-
-(define-syntax (cases stx)
-  (syntax-case stx (else)
-    [(_ <base-type> <input-var>
-        [<subtype> (<positional-var> ...) <body> ...] ...
-        [else <else-body> ...])
-     (inject-syntax ([#'(<subtype?> ...) (map-syntax (λ(s) (format-datum '~a? s)) #'(<subtype> ...))])
-                    #'(cond
-                        [(<subtype?> <input-var>) (match-let ([(list <positional-var> ...) (struct->list <input-var>)])
-                                                    <body> ...)] ...
-                                                                 [else <else-body> ...]))]
-    [(_ <base-type> <input-var>
-        <subtype-case> ...)
-     #'(cases <base-type> <input-var>
-         <subtype-case> ...
-         [else (void)])]))
-
-
-(define (occurs-free? search-var exp)
-  (cases lc-exp exp
-    [var-exp (var) (eqv? var search-var)]
-    [lambda-exp (bound-var body)
-                (and (not (eqv? search-var bound-var))
-                     (occurs-free? search-var body))]
-    [app-exp (rator rand)
-             (or
-              (occurs-free? search-var rator)
-              (occurs-free? search-var rand))]))
-
-
-
-(check-true (occurs-free? 'foo (var-exp 'foo)))
-(check-false (occurs-free? 'foo (var-exp 'bar)))
-(check-false (occurs-free? 'foo (lambda-exp 'foo (var-exp 'bar))))
-(check-true (occurs-free? 'foo (lambda-exp 'bar (var-exp 'foo))))
-(check-true (occurs-free? 'foo (lambda-exp 'bar (lambda-exp 'zim (lambda-exp 'zam (var-exp 'foo))))))

br/info.rkt

@@ -1 +0,0 @@
-#lang info

br/load.rkt

@@ -1,26 +0,0 @@
-#lang racket
-(provide (except-out (all-from-out racket) #%module-begin)
-         (rename-out [loader-module-begin #%module-begin]))
-
-#|
-
-br/load makes it possible to invoke a quick #lang by its pathname (without installing it as a collection)
-
-#lang br/load "path.rkt"
-
-Should simply delegate the reader & semantics.
-
-|#
-
-(define-syntax-rule (loader-module-begin loadpath expr ...)
-  (#%module-begin
-   (module loader-module loadpath
-     expr ...)
-   (require 'loader-module)
-   
-   (module reader racket/base
-     (require '(submod loadpath reader))
-     (provide (all-from-out '(submod loadpath reader))))))
-
-(module reader syntax/module-reader
-  br/load)

br/read-functions.rkt

@@ -1,34 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base) syntax/strip-context)
-(provide define-read-functions)
-
-;; `define-read-functions` simplifies support for the standard reading API,
-;; which asks for `read` and `read-syntax`.
-;; in general, `read` is just the datum from the result of `read-syntax`.
-
-(define-syntax-rule (define-read-functions (PATH PORT) BODY ...)
-  (begin
-    
-    (provide read read-syntax)
-    
-    (define (use-site-read-function PATH PORT)
-      BODY ...) ; don't care whether this produces datum or syntax
-    
-    (define (read-syntax path port)
-      ;; because `read-syntax` must produce syntax
-      ;; coerce a datum result to syntax if needed (à la `with-syntax`)
-      (define result-syntax (let ([output (use-site-read-function path port)])
-                              (if (syntax? output)
-                                  output 
-                                  (datum->syntax #f output))))
-      ;; because `read-syntax` must produce syntax without context
-      ;; see http://docs.racket-lang.org/guide/hash-lang_reader.html
-      ;; "a `read-syntax` function should return a syntax object with no lexical context"
-      (strip-context result-syntax)) 
-    
-    (define (read port)
-      ; because `read` must produce a datum
-      (let ([output (use-site-read-function #f port)])
-        (if (syntax? output)
-            (syntax->datum output)
-            output)))))

br/syntax.rkt

@@ -1,34 +0,0 @@
-#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 ...)]))
-
-(define-syntax syntax-let (make-rename-transformer #'add-syntax))
-
-(define-syntax inject-syntax (make-rename-transformer #'add-syntax))
-
-(define-syntax (map-syntax stx)
-  (syntax-case stx ()
-    [(_ <proc> <arg> ...)
-     #'(map <proc> (if (and (syntax? <arg>) (list? (syntax-e <arg>)))
-                       (syntax->list <arg>)
-                       <arg>) ...)]))
-
-
-#;(define-syntax syntax-variable (make-rename-transformer #'format-id))

br/test.rkt

@@ -1,5 +0,0 @@
-#lang racket/base
-(provide message)
-(define message "You installed beautiful-racket correctly.")
-(module+ main
-  (displayln message))

info.rkt

@@ -2,7 +2,7 @@
 (define collection 'multi)
 
 (define version "0.01")
-(define deps '("base" "sugar" "rackunit-lib" "ragg"))
+(define deps '("base" "sugar" "beautiful-racket-lib" "rackunit-lib" "ragg"))
 (define build-deps '("racket-doc"))
 
 (define test-omit-paths '("br-bf"))