diff --git a/br/conditional.rkt b/br/conditional.rkt deleted file mode 100644 index c28b561..0000000 --- a/br/conditional.rkt +++ /dev/null @@ -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)))) \ No newline at end of file diff --git a/br/datum.rkt b/br/datum.rkt deleted file mode 100644 index 192fd57..0000000 --- a/br/datum.rkt +++ /dev/null @@ -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 ) ...) - #'(format-datum (datum ) ...)] - [(_ (datum datum-template) ...) - (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 ...)))))]))) - -(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)) diff --git a/br/debug.rkt b/br/debug.rkt deleted file mode 100644 index 6a46b05..0000000 --- a/br/debug.rkt +++ /dev/null @@ -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) \ No newline at end of file diff --git a/br/define.rkt b/br/define.rkt deleted file mode 100644 index 1eaec3d..0000000 --- a/br/define.rkt +++ /dev/null @@ -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 ) - #'(apply + (list ))) - (foo 1 2 3)) 6) - (check-equal? (let () - (br:debug-define #'(foo ...) #'(apply * (list ...))) - (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)) \ No newline at end of file diff --git a/br/eopl.rkt b/br/eopl.rkt deleted file mode 100644 index f6fefb2..0000000 --- a/br/eopl.rkt +++ /dev/null @@ -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 - ( [ ] ...) ...) - #'(begin - (struct () #:transparent #:mutable) - (struct ( ...) #:transparent #:mutable - #:guard (λ( ... name) - (unless ( ) - (error name (format "arg ~a is not ~a" '))) ... - (values ...))) ...)) - - -(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) - [(_ - [ ( ...) ...] ... - [else ...]) - (inject-syntax ([#'( ...) (map-syntax (λ(s) (format-datum '~a? s)) #'( ...))]) - #'(cond - [( ) (match-let ([(list ...) (struct->list )]) - ...)] ... - [else ...]))] - [(_ - ...) - #'(cases - ... - [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)))))) \ No newline at end of file diff --git a/br/info.rkt b/br/info.rkt deleted file mode 100644 index e0c94f2..0000000 --- a/br/info.rkt +++ /dev/null @@ -1 +0,0 @@ -#lang info diff --git a/br/load.rkt b/br/load.rkt deleted file mode 100644 index c1e39fc..0000000 --- a/br/load.rkt +++ /dev/null @@ -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) \ No newline at end of file diff --git a/br/read-functions.rkt b/br/read-functions.rkt deleted file mode 100644 index 768fdd5..0000000 --- a/br/read-functions.rkt +++ /dev/null @@ -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))))) diff --git a/br/syntax.rkt b/br/syntax.rkt deleted file mode 100644 index b94d993..0000000 --- a/br/syntax.rkt +++ /dev/null @@ -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 () - [(_ ...) - #'(map (if (and (syntax? ) (list? (syntax-e ))) - (syntax->list ) - ) ...)])) - - -#;(define-syntax syntax-variable (make-rename-transformer #'format-id)) \ No newline at end of file diff --git a/br/test.rkt b/br/test.rkt deleted file mode 100644 index 2e4ecd2..0000000 --- a/br/test.rkt +++ /dev/null @@ -1,5 +0,0 @@ -#lang racket/base -(provide message) -(define message "You installed beautiful-racket correctly.") -(module+ main - (displayln message)) \ No newline at end of file diff --git a/info.rkt b/info.rkt index 841b043..71c76c2 100644 --- a/info.rkt +++ b/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")) \ No newline at end of file