From 892d81bfb5d5acc7b3061cfb81b3008860f2bbc3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 2 Mar 2016 11:40:56 -0800 Subject: [PATCH] working files --- README.md | 12 +++- br/datum.rkt | 32 ++++++++++ br/debug.rkt | 17 +++++ br/define.rkt | 41 ++++++++++++ br/ex/nothing/nothing-invoked-as-reader.rkt | 1 + .../nothing/nothing-invoked-as-semantics.rkt | 1 + br/ex/nothing/nothing.rkt | 39 ++++++++++++ .../expander-only/expander-invoked.rkt | 10 +++ br/ex/simples/expander-only/expander.rkt | 11 ++++ br/ex/simples/rapl/rapl.rkt | 61 ++++++++++++++++++ br/ex/simples/rapl/rapltest.rkt | 7 +++ br/ex/simples/reader-only/reader-invoked.rkt | 3 + br/ex/simples/reader-only/reader.rkt | 9 +++ .../stack compiler/stack-compiler-invoked.rkt | 3 + .../simples/stack compiler/stack-compiler.rkt | 33 ++++++++++ br/ex/simples/stack/stack-invoked.rkt | 21 +++++++ br/ex/simples/stack/stack.rkt | 62 +++++++++++++++++++ br/ex/simples/stack/stacker/info.rkt | 2 + br/ex/simples/stack/stacker/stacker-lang.rkt | 35 +++++++++++ br/ex/simples/stack/stacker/stacker-test.rkt | 6 ++ br/info.rkt | 2 + br/load.rkt | 26 ++++++++ br/main.rkt | 19 ++++++ br/scribble-xexpr.rkt | 40 ++++++++++++ br/syntax.rkt | 20 ++++++ info.rkt | 6 ++ 26 files changed, 518 insertions(+), 1 deletion(-) create mode 100644 br/datum.rkt create mode 100644 br/debug.rkt create mode 100644 br/define.rkt create mode 100644 br/ex/nothing/nothing-invoked-as-reader.rkt create mode 100644 br/ex/nothing/nothing-invoked-as-semantics.rkt create mode 100644 br/ex/nothing/nothing.rkt create mode 100644 br/ex/simples/expander-only/expander-invoked.rkt create mode 100644 br/ex/simples/expander-only/expander.rkt create mode 100644 br/ex/simples/rapl/rapl.rkt create mode 100644 br/ex/simples/rapl/rapltest.rkt create mode 100644 br/ex/simples/reader-only/reader-invoked.rkt create mode 100644 br/ex/simples/reader-only/reader.rkt create mode 100644 br/ex/simples/stack compiler/stack-compiler-invoked.rkt create mode 100644 br/ex/simples/stack compiler/stack-compiler.rkt create mode 100644 br/ex/simples/stack/stack-invoked.rkt create mode 100644 br/ex/simples/stack/stack.rkt create mode 100644 br/ex/simples/stack/stacker/info.rkt create mode 100644 br/ex/simples/stack/stacker/stacker-lang.rkt create mode 100644 br/ex/simples/stack/stacker/stacker-test.rkt create mode 100644 br/info.rkt create mode 100644 br/load.rkt create mode 100644 br/main.rkt create mode 100644 br/scribble-xexpr.rkt create mode 100644 br/syntax.rkt create mode 100644 info.rkt diff --git a/README.md b/README.md index 82b656c..944b3b6 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,15 @@ **beautiful-racket** -Resources for the “Beautiful Racket” book +Resources for the upcoming “Beautiful Racket” book, including: + +* `#lang br` teaching language + + +Installation: `raco pkg install beautiful-racket` + + +Update: + +`raco pkg update beautiful-racket` diff --git a/br/datum.rkt b/br/datum.rkt new file mode 100644 index 0000000..960d80b --- /dev/null +++ b/br/datum.rkt @@ -0,0 +1,32 @@ +#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 (list arg ...))))]))) + + +(module+ test + (require rackunit) + (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 (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 new file mode 100644 index 0000000..6a46b05 --- /dev/null +++ b/br/debug.rkt @@ -0,0 +1,17 @@ +#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 new file mode 100644 index 0000000..25e1c2d --- /dev/null +++ b/br/define.rkt @@ -0,0 +1,41 @@ +#lang racket/base +(require (for-syntax racket/base syntax/parse)) +(provide (all-defined-out)) + +(define-syntax (br:define stx) + (define-syntax-class syntaxed-id + #:literals (syntax) + #:description "id in syntaxed form" + (pattern (syntax name:id))) + + (syntax-parse stx + #:literals (syntax) + [(_ (syntax (id pat-arg ...)) (syntax body ...)) ; (define #'(foo arg) #'(+ arg arg)) + #'(define-syntax-rule (id pat-arg ...) body ...)] + + [(_ sid:syntaxed-id sid2:syntaxed-id) ; (define #'f1 #'f2) + #'(define-syntax sid.name (make-rename-transformer 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) + (check-equal? (plus 42) +) + (check-equal? plusser +) + (check-equal? (plusser 42) +) + (check-equal? (times 10) 100) + (check-equal? (timeser 12) 144) + ;; todo: error from define not trapped by check-exn + #;(check-exn exn:fail:syntax? (λ _ (br:define (#'times stx stx2) #'*)))) \ No newline at end of file diff --git a/br/ex/nothing/nothing-invoked-as-reader.rkt b/br/ex/nothing/nothing-invoked-as-reader.rkt new file mode 100644 index 0000000..e90c683 --- /dev/null +++ b/br/ex/nothing/nothing-invoked-as-reader.rkt @@ -0,0 +1 @@ +#lang reader (submod "nothing.rkt" reader) \ No newline at end of file diff --git a/br/ex/nothing/nothing-invoked-as-semantics.rkt b/br/ex/nothing/nothing-invoked-as-semantics.rkt new file mode 100644 index 0000000..62219b8 --- /dev/null +++ b/br/ex/nothing/nothing-invoked-as-semantics.rkt @@ -0,0 +1 @@ +#lang s-exp "nothing.rkt" \ No newline at end of file diff --git a/br/ex/nothing/nothing.rkt b/br/ex/nothing/nothing.rkt new file mode 100644 index 0000000..7f518f2 --- /dev/null +++ b/br/ex/nothing/nothing.rkt @@ -0,0 +1,39 @@ +#lang racket +(provide (all-from-out racket)) + +(module reader syntax/module-reader + br/ex/nothing/nothing) + +#| + +#lang racket +(provide (all-from-out racket)) + +(module reader racket/base + (provide read read-syntax)) + +|# + +#| + +(module nothing racket + (provide (all-from-out racket)) + + (module reader syntax/module-reader + br/ex/nothing)) + +|# + +#| + +#lang racket + +(module reader syntax/module-reader + #:language '(submod br/ex/nothing semantics)) + +(module semantics racket + (provide (all-from-out racket))) + +(sleep 100000) + +|# diff --git a/br/ex/simples/expander-only/expander-invoked.rkt b/br/ex/simples/expander-only/expander-invoked.rkt new file mode 100644 index 0000000..b6dfe6d --- /dev/null +++ b/br/ex/simples/expander-only/expander-invoked.rkt @@ -0,0 +1,10 @@ +#lang s-exp "expander.rkt" + +"asdf" + + +41 + +1+2i + +;; but not foo \ No newline at end of file diff --git a/br/ex/simples/expander-only/expander.rkt b/br/ex/simples/expander-only/expander.rkt new file mode 100644 index 0000000..9d9310a --- /dev/null +++ b/br/ex/simples/expander-only/expander.rkt @@ -0,0 +1,11 @@ +#lang br +(provide (rename-out [simple-module-begin #%module-begin]) + #%datum #%top-interaction) +(define #'(simple-module-begin expr ...) + #'(#%module-begin + (define lines (list expr ...)) + (display (format "Expressions = ~a" (length lines))) + (define numbers (filter number? lines)) + (unless (zero? (length numbers)) + (displayln (format ", numbers = ~a" (length numbers))) + (apply + numbers)))) \ No newline at end of file diff --git a/br/ex/simples/rapl/rapl.rkt b/br/ex/simples/rapl/rapl.rkt new file mode 100644 index 0000000..4655247 --- /dev/null +++ b/br/ex/simples/rapl/rapl.rkt @@ -0,0 +1,61 @@ +#lang br +(require racket/function) +(provide (except-out (all-from-out br) + *) + (rename-out [my+ +] [my* *]) ⌊) + +(define (⌊ largs rargs) + (let ([lenlargs (length largs)] + [lenrargs (length rargs)]) + (cond + [(zero? lenlargs) + (map (compose1 inexact->exact floor) rargs)] + [(= lenlargs lenrargs) + (map min + largs rargs)]))) + +(define (my* largs rargs) + (let ([lenlargs (length largs)] + [lenrargs (length rargs)]) + (cond + [(= lenlargs lenrargs) + (map * largs rargs)] + [(= 1 lenlargs) + (map (curry * (car largs)) rargs)] + [(= 1 lenrargs) + (my* rargs largs)] + [else + (error 'length-error)]))) + +(define (my+ largs rargs) + (let ([lenlargs (length largs)] + [lenrargs (length rargs)]) + (cond + [(= lenlargs lenrargs) + (map + largs rargs)] + [(= 1 lenlargs) + (map (curry + (car largs)) rargs)] + [(= 1 lenrargs) + (my+ rargs largs)] + [else + (error 'length-error)]))) + +(module reader br + (provide read-syntax) + (define (read-syntax src-path src-port) + (define operators '(+ ⌊ *)) + (define src-exprs (for/list ([ln (in-lines src-port)] + #:when (regexp-match #px"\\w" ln)) + (format-datum '(begin ~a) ln))) + (with-syntax ([(src-expr ...) src-exprs]) + (syntax->datum #'(module rapl "rapl.rkt" + (displayln 'src-expr) ...))))) + + + +#;(module+ test + (require rackunit) + (check-equal? (+ '(4) '(7)) '(11)) + (check-equal? (+ '(3) '(2 4 11 7 5)) '(5 7 14 10 8)) + (check-equal? (+ '(6 3 8 1) '(3)) '(9 6 11 4)) + (check-equal? (+ '(6 3 8 1) '(3 6 1 8)) '(9 9 9 9)) + (check-exn exn:fail? (λ _ (+ '(6 8 1) '(3 6 1 8))))) \ No newline at end of file diff --git a/br/ex/simples/rapl/rapltest.rkt b/br/ex/simples/rapl/rapltest.rkt new file mode 100644 index 0000000..a8f8bc5 --- /dev/null +++ b/br/ex/simples/rapl/rapltest.rkt @@ -0,0 +1,7 @@ +#lang reader (submod "rapl.rkt" reader) + +1 3 3 7 * 8.41 + +⌊ 8.41 + +5 ⌊ 8.41 \ No newline at end of file diff --git a/br/ex/simples/reader-only/reader-invoked.rkt b/br/ex/simples/reader-only/reader-invoked.rkt new file mode 100644 index 0000000..124caef --- /dev/null +++ b/br/ex/simples/reader-only/reader-invoked.rkt @@ -0,0 +1,3 @@ +#lang reader "reader.rkt" + +This is a terrible idea, and I should know because I invented it. \ No newline at end of file diff --git a/br/ex/simples/reader-only/reader.rkt b/br/ex/simples/reader-only/reader.rkt new file mode 100644 index 0000000..c730417 --- /dev/null +++ b/br/ex/simples/reader-only/reader.rkt @@ -0,0 +1,9 @@ +#lang br +(provide read-syntax) + +(define (read-syntax src in) + (syntax-let ([#'src-str (port->string in)]) + #'(module no-name racket + (define (scramble str) + (list->string (shuffle (string->list str)))) + (regexp-replace* #px"\\w+" src-str scramble)))) diff --git a/br/ex/simples/stack compiler/stack-compiler-invoked.rkt b/br/ex/simples/stack compiler/stack-compiler-invoked.rkt new file mode 100644 index 0000000..f68b972 --- /dev/null +++ b/br/ex/simples/stack compiler/stack-compiler-invoked.rkt @@ -0,0 +1,3 @@ +#lang reader "stack-compiler.rkt" + +(* (/ 25 14 (expt 5 2)) (/ 2 3 1) (* 10 12 15)) diff --git a/br/ex/simples/stack compiler/stack-compiler.rkt b/br/ex/simples/stack compiler/stack-compiler.rkt new file mode 100644 index 0000000..cd31835 --- /dev/null +++ b/br/ex/simples/stack compiler/stack-compiler.rkt @@ -0,0 +1,33 @@ +#lang br + +(provide #%top-interaction) ; activates the REPL + +;; reader goes first and +;; 1) converts surface syntax into Rackety expressions (wrapping in `(inst ...)`) +;; 2) creates a module specifying semantics source (in this case, same module) +(provide read-syntax) +(define (read-syntax src-path src-input-port) + (define expr-datums (for/list ([src-line (in-lines src-input-port)] + #:when (regexp-match #px"\\w" src-line)) + (format-datum '~a src-line))) + (syntax-let ([#'(expr-stx ...) expr-datums]) ; ok to bind with non-syntax + #'(module stack-compiler-module "stack-compiler.rkt" + expr-stx ...))) + + +;; semantics always start with #%module-begin, which unwraps the content of the module and rewraps it +(provide (rename-out [stack-module-begin #%module-begin])) +(define #'(stack-module-begin expr ...) + #'(#%module-begin + (stackify (quote expr)) ...)) + + +(define (stackify quoted-expr) + (define pushes + (let loop ([x quoted-expr]) + (cond + [(list? x) + (match-define (list op args ...) x) + (append (make-list (sub1 (length args)) op) (flatten (map loop args)))] + [else x]))) + (for-each displayln (map (λ(p) (format "push ~a" p)) (reverse pushes)))) \ No newline at end of file diff --git a/br/ex/simples/stack/stack-invoked.rkt b/br/ex/simples/stack/stack-invoked.rkt new file mode 100644 index 0000000..430242b --- /dev/null +++ b/br/ex/simples/stack/stack-invoked.rkt @@ -0,0 +1,21 @@ +#lang reader "stack.rkt" + +push 15 +push 12 +push 10 +push * +push * +push 1 +push 3 +push 2 +push / +push / +push 2 +push 5 +push expt +push 14 +push 25 +push / +push / +push * +push * \ No newline at end of file diff --git a/br/ex/simples/stack/stack.rkt b/br/ex/simples/stack/stack.rkt new file mode 100644 index 0000000..0a4296b --- /dev/null +++ b/br/ex/simples/stack/stack.rkt @@ -0,0 +1,62 @@ +#lang br + +(provide #%top-interaction) ; activates the REPL + +;; reader goes first and +;; 1) converts surface syntax into Rackety expressions (wrapping in `(inst ...)`) +;; 2) creates a module specifying semantics source (in this case, same module) +(provide read-syntax) +(define (read-syntax src-path src-input-port) + (define inst-datums (for/list ([src-line (in-lines src-input-port)] + #:when (regexp-match #px"\\w" src-line)) + (format-datum '(inst ~a) src-line))) + (syntax-let ([#'(inst-stx ...) inst-datums]) ; ok to bind with non-syntax + #'(module stack-lang-module "stack.rkt" + inst-stx ...))) + +(define stack empty) + +;; semantics always start with #%module-begin, which unwraps the content of the module and rewraps it +(provide (rename-out [stack-module-begin #%module-begin])) +(define #'(stack-module-begin instructions ...) + #'(#%module-begin + instructions ... + (first stack))) + + +;; then file is processed like a normal Racket file. + +(provide inst) +(define (inst . args) + (if (<= 1 (length args) 2) + (let ([proc (first args)]) + (apply proc (cdr args))) + (void))) + + +(provide push) +(define (push arg) + (display "push: ") + (cond + [(procedure? arg) + (displayln (format "got ~a, replacing ~a and ~a with result" arg (first stack) (second stack) )) + (set! stack (cons (arg (first stack) (second stack)) (cddr stack)))] + [else (displayln (format "storing value ~a" arg)) + (set! stack (cons arg stack))]) + (displayln stack)) + +;; exercises + +(provide pop) +(define (pop) + (display "pop: ") + (displayln (format "got ~a" (car stack))) + (set! stack (cdr stack)) + (displayln stack)) + +(provide swap) +(define (swap) + (display "swap: ") + (displayln (format "~a and ~a" (first stack) (second stack))) + (set! stack (list* (second stack) (first stack) (cddr stack))) + (displayln stack)) \ No newline at end of file diff --git a/br/ex/simples/stack/stacker/info.rkt b/br/ex/simples/stack/stacker/info.rkt new file mode 100644 index 0000000..a85009f --- /dev/null +++ b/br/ex/simples/stack/stacker/info.rkt @@ -0,0 +1,2 @@ +#lang info +(define collection "stacker") \ No newline at end of file diff --git a/br/ex/simples/stack/stacker/stacker-lang.rkt b/br/ex/simples/stack/stacker/stacker-lang.rkt new file mode 100644 index 0000000..47eaac0 --- /dev/null +++ b/br/ex/simples/stack/stacker/stacker-lang.rkt @@ -0,0 +1,35 @@ +#lang br +(define (read-syntax src-path src-port) + (define src-strs (port->lines src-port)) + (define (make-datum str) (format-datum '(dispatch ~a) str)) + (define src-exprs (map make-datum src-strs)) + (inject-syntax ([#'(list src-expr ...) src-exprs]) + #'(module stacker-mod "stacker-lang.rkt" + src-expr ...))) +(provide read-syntax) + +(define #'(stacker-module-begin reader-line ...) + #'(#%module-begin + reader-line ... + (display (first stack)))) +(provide (rename-out [stacker-module-begin #%module-begin])) + +(define stack (list 0 0)) +(define (push num) (set! stack (cons num stack))) + +(define (dispatch arg-1 [arg-2 #f]) + (cond + [(number? arg-2) (push arg-2)] + [else + (define op arg-1) + (define op-result (op (first stack) (second stack))) + (set! stack (cons op-result (drop stack 2)))])) + +#;(define dispatch + (case-lambda + [(push num) (push num)] + [(stack-op) + (define op-result (stack-op (first stack) (second stack))) + (set! stack (cons op-result (drop stack 2)))])) + +(provide #%top-interaction) \ No newline at end of file diff --git a/br/ex/simples/stack/stacker/stacker-test.rkt b/br/ex/simples/stack/stacker/stacker-test.rkt new file mode 100644 index 0000000..9a4b760 --- /dev/null +++ b/br/ex/simples/stack/stacker/stacker-test.rkt @@ -0,0 +1,6 @@ +#lang reader "stacker-lang.rkt" +push 4 +push 8 ++ +push 3 +* \ No newline at end of file diff --git a/br/info.rkt b/br/info.rkt new file mode 100644 index 0000000..3d54b76 --- /dev/null +++ b/br/info.rkt @@ -0,0 +1,2 @@ +#lang info +(define test-omit-paths 'all) \ No newline at end of file diff --git a/br/load.rkt b/br/load.rkt new file mode 100644 index 0000000..c1e39fc --- /dev/null +++ b/br/load.rkt @@ -0,0 +1,26 @@ +#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/main.rkt b/br/main.rkt new file mode 100644 index 0000000..2a179f7 --- /dev/null +++ b/br/main.rkt @@ -0,0 +1,19 @@ +#lang racket/base +(require racket/provide racket/list racket/string racket/format racket/match racket/port + br/define br/syntax br/datum br/debug + (for-syntax racket/base racket/syntax br/syntax br/define)) +(provide (except-out (all-from-out racket/base) define) + (all-from-out racket/list racket/string racket/format racket/match racket/port + br/syntax br/datum br/debug) + (for-syntax (all-from-out racket/base racket/syntax br/syntax)) + (filtered-out + (λ (name) + (let ([pat (regexp "^br:")]) + (and (regexp-match? pat name) + (regexp-replace pat name "")))) + (combine-out (all-from-out br/define)))) + +;; todo: activate at-exp reader by default + +(module reader syntax/module-reader + #:language 'br) \ No newline at end of file diff --git a/br/scribble-xexpr.rkt b/br/scribble-xexpr.rkt new file mode 100644 index 0000000..0765ebd --- /dev/null +++ b/br/scribble-xexpr.rkt @@ -0,0 +1,40 @@ +#lang at-exp br +(require scribble/manual scribble/core txexpr) +(provide scribble->xexpr) + +(define (style->attrs s style-accessor) + (let* ([style-datum (style-accessor s)]) + (if (style? style-datum) ; either style struct, or simple symbol name + `((style ,(~a (style-name style-datum))) + (properties ,(string-join (map ~a (style-properties style-datum)) " "))) + `((style ,(~a style-datum)))))) + + +;; Unfortunately there seems to be no generic way of fetching the style & elements from a Scribble structure +;; the specific struct accessors must be used. +(define #'structure->txexpr + (λ(stx) + (syntax-match stx + [#'(_ structure-name elem-name id) + (syntax-let ([#'structure-name-elem-name (format-id stx "~a-~a" #'structure-name #'elem-name)] + [#'structure-name-style (format-id stx "~a-style" #'structure-name)]) + #'(let* ([elem-raw (structure-name-elem-name id)] + [elems (map scribble->xexpr (if (list? elem-raw) + (flatten elem-raw) + (list elem-raw)))]) +(list* 'structure-name (style->attrs id structure-name-style) elems)))]))) + +(define (scribble->xexpr s) + (cond + [(nested-flow? s) (structure->txexpr nested-flow blocks s)] + [(paragraph? s) (structure->txexpr paragraph content s)] + [(element? s) (structure->txexpr element content s)] + [else s])) + +(module+ test + (require rackunit) + (define-simple-check (check-sx? s) + (check-true (txexpr? (scribble->xexpr s)))) + (check-sx? @racketblock[(list +)]) + (check-sx? @racket[(list +)]) + (check-sx? @code{(list +)})) diff --git a/br/syntax.rkt b/br/syntax.rkt new file mode 100644 index 0000000..ee4b6e6 --- /dev/null +++ b/br/syntax.rkt @@ -0,0 +1,20 @@ +#lang racket/base +(require (for-syntax racket/base syntax/parse #;racket/syntax) #;racket/syntax) +(provide (all-defined-out)) + +(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) + (syntax-case stx (syntax) + [(_ ([(syntax sid) sid-stx] ...) body ...) + #'(with-syntax ([sid sid-stx] ...) body ...)])) + +(define-syntax syntax-let (make-rename-transformer #'add-syntax)) + +(define-syntax inject-syntax (make-rename-transformer #'add-syntax)) + +#;(define-syntax syntax-variable (make-rename-transformer #'format-id)) \ No newline at end of file diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..e518c00 --- /dev/null +++ b/info.rkt @@ -0,0 +1,6 @@ +#lang info +(define collection 'multi) + +(define version "0.01") +(define deps '("base")) +(define build-deps '("racket-doc"))