Compare commits

..

No commits in common. 'master' and 'v6.3-exception' have entirely different histories.

@ -1,72 +0,0 @@
name: CI
on: [push, pull_request]
jobs:
run:
name: "Build using Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})"
runs-on: ubuntu-latest
continue-on-error: ${{ matrix.xfail == 'yes' }}
strategy:
fail-fast: false
matrix:
racket-version: ["6.7", "6.8", "6.9", "6.11", "6.12", "7.0", "7.1", "7.2", "7.3", "7.4", "7.5", "7.6", "7.7", "7.8", "7.9", "8.0", "8.1", "current"]
racket-variant: ["BC", "CS"]
# CS builds are only provided for versions 7.4 and up so avoid
# running the job for prior versions.
exclude:
- {racket-version: "6.6", racket-variant: "CS"}
- {racket-version: "6.7", racket-variant: "CS"}
- {racket-version: "6.8", racket-variant: "CS"}
- {racket-version: "6.9", racket-variant: "CS"}
- {racket-version: "6.10.1", racket-variant: "CS"}
- {racket-version: "6.11", racket-variant: "CS"}
- {racket-version: "6.12", racket-variant: "CS"}
- {racket-version: "7.0", racket-variant: "CS"}
- {racket-version: "7.1", racket-variant: "CS"}
- {racket-version: "7.2", racket-variant: "CS"}
- {racket-version: "7.3", racket-variant: "CS"}
include:
- {racket-version: "6.7", racket-variant: "BC", xfail: "yes"}
- {racket-version: "7.7", racket-variant: "CS", xfail: "yes"}
- {racket-version: "7.8", racket-variant: "CS", xfail: "yes"}
- {racket-version: "7.9", racket-variant: "CS", xfail: "yes"}
- {racket-version: "current", racket-variant: "BC", xfail: "yes"}
- {racket-version: "current", racket-variant: "CS", xfail: "yes"}
env:
DISPLAY: :99
steps:
- name: Checkout
uses: actions/checkout@master
- uses: Bogdanp/setup-racket@v0.11
with:
distribution: 'full'
version: ${{ matrix.racket-version }}
variant: ${{ matrix.racket-variant }}
- name: Install package and its dependencies
run: raco pkg install --deps search-auto https://github.com/mbutterick/br-parser-tools.git?path=br-parser-tools-lib
- name: install brag
run: raco pkg install --deps search-auto https://github.com/mbutterick/brag.git?path=brag
- name: install br-macro
run: raco pkg install --deps search-auto https://github.com/mbutterick/beautiful-racket.git?path=beautiful-racket-macro
- name: install br lib
run: raco pkg install --deps search-auto https://github.com/mbutterick/beautiful-racket.git?path=beautiful-racket-lib
- name: install br demo
run: raco pkg install --deps search-auto https://github.com/mbutterick/beautiful-racket.git?path=beautiful-racket-demo
- name: install br
run: raco pkg install --deps search-auto https://github.com/mbutterick/beautiful-racket.git?path=beautiful-racket
- name: Start virtual framebuffer
run: Xvfb "$DISPLAY" -screen 0 1280x1024x24 &
- name: Run the brm tests
run: raco test -p beautiful-racket-macro
- name: Run the lib tests
run: raco test -p beautiful-racket-lib
- name: Run the demo tests
run: raco test -p beautiful-racket-demo
- name: Run the br tests
run: raco test -p beautiful-racket

@ -0,0 +1,58 @@
# adapted from
# https://github.com/greghendershott/travis-racket/blob/master/.travis.yml
# Thanks Greg!
language: c
sudo: false
env:
global:
- RACKET_DIR=~/racket
matrix:
# - RACKET_VERSION=6.0
# - RACKET_VERSION=6.1
# - RACKET_VERSION=6.2
- RACKET_VERSION=6.3
# - RACKET_VERSION=6.4
# - RACKET_VERSION=6.5
- RACKET_VERSION=6.6
# - RACKET_VERSION=6.7
# - RACKET_VERSION=6.8
- RACKET_VERSION=6.9
# - RACKET_VERSION=6.10
# - RACKET_VERSION=6.11
- RACKET_VERSION=6.12
- RACKET_VERSION=7.0
- RACKET_VERSION=7.1
- RACKET_VERSION=HEAD
- RACKET_VERSION=HEADCS
# You may want to test against certain versions of Racket, without
# having them count against the overall success/failure.
matrix:
allow_failures:
#- env: RACKET_VERSION=HEAD
- env: RACKET_VERSION=HEADCS
# Fast finish: Overall build result is determined as soon as any of
# its rows have failed, or, all of its rows that aren't allowed to
# fail have succeeded.
fast_finish: true
before_install:
- "export DISPLAY=:99.0" # needed for testing with `racket/gui`
- "sh -e /etc/init.d/xvfb start" # needed for testing with `racket/gui`
- git clone https://github.com/mbutterick/travis-racket.git
- cat travis-racket/install-racket.sh | bash # pipe to bash not sh!
- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
script:
- cd .. # Travis did a cd into the dir. Back up, for the next:
# don't rely on package server
- travis_retry raco pkg install --deps search-auto https://github.com/mbutterick/br-parser-tools.git?path=br-parser-tools-lib
- travis_retry raco pkg install --deps search-auto https://github.com/mbutterick/brag.git?path=brag
- travis_retry raco pkg install --deps search-auto https://github.com/mbutterick/beautiful-racket.git?path=beautiful-racket-lib
- raco test -p beautiful-racket-lib
- travis_retry raco pkg install --deps search-auto https://github.com/mbutterick/beautiful-racket.git?path=beautiful-racket-demo
- raco test -p beautiful-racket-demo
- travis_retry raco pkg install --deps search-auto https://github.com/mbutterick/beautiful-racket.git?path=beautiful-racket
- raco test -p beautiful-racket

@ -1,9 +0,0 @@
MIT License for `beautiful-racket`
© 2016-2019 Matthew Butterick
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@ -1,5 +1,5 @@
## beautiful-racket [![Build Status](https://github.com/mbutterick/beautiful-racket/workflows/CI/badge.svg)](https://github.com/mbutterick/beautiful-racket/actions)
beautiful-racket [![Build Status](https://travis-ci.org/mbutterick/beautiful-racket.svg?branch=master)](https://travis-ci.org/mbutterick/beautiful-racket)
-
Resources for the “Beautiful Racket” book, including:
@ -10,25 +10,28 @@ Resources for the “Beautiful Racket” book, including:
* sample languages
## Installation
Installation
-
`raco pkg install beautiful-racket`
## Update
Update
-
`raco pkg update --update-deps beautiful-racket`
## Documentation
Documentation
-
http://docs.racket-lang.org/br
## License
MIT
MIT license
-
`beautiful-racket` © 2016-2019 Matthew Butterick
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
## Project status
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
Complete. I will maintain the code but no major updates are planned.
THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@ -1,6 +1,9 @@
#lang brag
top : (fun | app)*
fun : /"fun" ID /"(" ID [/"," ID] /")" /"=" expr
expr : ID /"+" ID | app
app : ID /"(" (ID | INT) [/"," ID] /")"
top : (func-def | func-app)*
func-def : /"fun" var /"(" vars /")" /"=" expr
/vars : var [/"," var]
expr : var "+" var | value
@value : var | INT | func-app
func-app : var /"(" value [/"," value] /")"
@var : ID

@ -1,6 +1,6 @@
#lang br/quicklang
(require brag/support "grammar.rkt")
(provide top fun expr app)
(provide (all-defined-out) #%module-begin)
(module+ reader
(provide read-syntax))
@ -8,29 +8,27 @@
(define-lex-abbrev reserved-toks
(:or "fun" "(" ")" "=" "+" ","))
(define tokenize-1
(define tokenize
(lexer
[whitespace (token lexeme #:skip? #t)]
[(from/stop-before "#" "\n") (token 'COMMENT #:skip? #t)]
[whitespace (tokenize input-port)]
[reserved-toks lexeme]
[(:+ alphabetic) (token 'ID (string->symbol lexeme))]
[alphabetic (token 'ID (string->symbol lexeme))]
[(:+ (char-set "0123456789")) (token 'INT (string->number lexeme))]))
(define-macro top #'#%module-begin)
(define-macro top #'begin)
(define-macro-cases fun
[(_ VAR ARG0 EXPR) #'(define (VAR ARG0) EXPR)]
[(_ VAR ARG0 ARG1 EXPR) #'(define (VAR ARG0 ARG1) EXPR)])
(define-macro (func-def VAR VARS EXPR)
#'(define (VAR . VARS) EXPR))
(define-macro-cases expr
[(_ LEFT RIGHT) #'(+ LEFT RIGHT)]
[(_ LEFT "+" RIGHT) #'(+ LEFT RIGHT)]
[(_ OTHER) #'OTHER])
(define-macro app #'#%app)
(define-macro func-app #'#%app)
(define (read-syntax src ip)
(define parse-tree (parse src (λ () (tokenize-1 ip))))
(strip-bindings
(define parse-tree (parse (λ () (tokenize ip))))
(strip-context
(with-syntax ([PT parse-tree])
#'(module algebra-mod algebra-demo
#'(module mod-name algebra-demo
PT))))

@ -1,6 +1,4 @@
#lang algebra-demo
fun f(x,y) = x + y
# fun f(x,y) = x * y
fun g(zz) = f(zz,zz)
fun g(z) = f(z,z)
g(10)
g(23)

@ -1,4 +1,4 @@
#lang br
#lang racket
(provide #%top-interaction #%module-begin
(rename-out [my-datum #%datum]
[my-datum #%top]

@ -3,7 +3,7 @@
(define-lex-abbrev digits (:+ (char-set "0123456789")))
(define-lex-abbrev reserved-terms (:or "print" "goto" "end" "+" ":" ";" "let" "=" "input" "-" "*" "/" "^" "mod" "(" ")" "if" "then" "else" "<" ">" "<>" "and" "or" "not" "gosub" "return" "for" "to" "step" "next"))
(define-lex-abbrev reserved-terms (:or "print" "goto" "end" "+" ":" ";" "let" "=" "input" "-" "*" "/" "^" "mod" "(" ")" "def" "if" "then" "else" "<" ">" "<>" "and" "or" "not" "gosub" "return" "for" "to" "step" "next"))
(define basic-lexer
(lexer-srcloc

@ -3,7 +3,7 @@
(define-lex-abbrev digits (:+ (char-set "0123456789")))
(define-lex-abbrev reserved-terms (:or "print" "goto" "end" "+" ":" ";" "let" "=" "input" "-" "*" "/" "^" "mod" "(" ")" "if" "then" "else" "<" ">" "<>" "and" "or" "not" "gosub" "return" "for" "to" "step" "next" "def" "," "import" "export"))
(define-lex-abbrev reserved-terms (:or "print" "goto" "end" "+" ":" ";" "let" "=" "input" "-" "*" "/" "^" "mod" "(" ")" "def" "if" "then" "else" "<" ">" "<>" "and" "or" "not" "gosub" "return" "for" "to" "step" "next" "def" "," "import" "export"))
(define-lex-abbrev racket-id-kapu
(:or whitespace (char-set "()[]{}\",'`;#|\\")))

@ -1,26 +0,0 @@
#lang br/quicklang
(module reader br
(provide read-syntax)
(define (read-syntax name port)
(define s-exprs (let loop ([toks null])
(define tok (read port))
(if (eof-object? tok)
(reverse toks)
(loop (cons tok toks)))))
(strip-bindings
(with-syntax ([(EXPR ...) s-exprs])
#'(module read-only-mod conjunction-demo
EXPR ...)))))
(define (convert-expr x)
(cond
[(list? x) (map convert-expr x)]
[(number? x) 42]
[(string? x) "whee"]
[else 'kaboom]))
(define-macro (my-module-begin EXPR ...)
#'(#%module-begin
(convert-expr 'EXPR) ...))
(provide (rename-out [my-module-begin #%module-begin]))

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

@ -1,40 +0,0 @@
#lang br
(require racket/file)
#|
(define src (file->string "source.txt"))
(define strs (string-split src))
(define toks (map (λ (str) (or (string->number str) (string->symbol str))) strs))
(define expr (list (second toks) (first toks) (third toks)))
(eval expr (make-base-namespace))
|#
#|
(eval
(match (for/list ([str (in-list (string-split (file->string "source.txt")))])
(or (string->number str) (string->symbol str)))
[(list num1 op num2) (list op num1 num2)])
(make-base-namespace))
|#
(define (eval-src src)
(eval
(match (for/list ([str (in-list (string-split src))])
(or (string->number str) (string->symbol str)))
[(list num1 op num2) (list op num1 num2)]) (make-base-namespace)))
(module reader br
(provide read-syntax)
(define (read-syntax name ip)
`(module mod "main.rkt"
,(port->string ip))))
(provide #%datum #%top-interaction (rename-out [mb #%module-begin]))
(define-macro (mb SRC)
#'(#%module-begin
(eval-src SRC)))

@ -1,2 +0,0 @@
#lang dyadic-demo
12 + 34

@ -1,13 +0,0 @@
#lang br
(define (convert-expr x)
(cond
[(list? x) (map convert-expr x)]
[(number? x) 42]
[(string? x) "whee"]
[else 'kaboom]))
(define-macro (my-module-begin EXPR ...)
#'(#%module-begin
(convert-expr 'EXPR) ...))
(provide (rename-out [my-module-begin #%module-begin]))

@ -1,4 +0,0 @@
#lang s-exp expand-only-demo
"hello world"
(+ 1 (* 2 (- x)))

@ -5,11 +5,9 @@
(define collection 'multi)
(define version "1.6")
(define version "1.4")
;; base v6.7 dependency needs to be called 6.6.0.900
;; due to strange little bug in `raco pkg install`
(define deps '(["base" #:version "6.6.0.900"]
(define deps '(["base" #:version "6.3"]
"sugar"
"beautiful-racket-lib"
"rackunit-lib"
@ -19,5 +17,3 @@
"syntax-color-lib"
"gui-lib"
"math-lib"))
(define build-deps '("at-exp-lib"))

@ -1,18 +0,0 @@
#lang br
(provide #%top-interaction #%module-begin
(rename-out [my-datum #%datum]
[my-datum #%top]
[my-app #%app]))
(define-macro (my-datum . THING)
(define datum (syntax->datum #'THING))
(cond
[(string? datum) #'"whee"]
[(number? datum) #'42]
[else #''kaboom]))
(define-macro (my-app FUNC . ARGS)
#'(list FUNC . ARGS))
(module reader syntax/module-reader
injunction-demo)

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

@ -11,7 +11,7 @@
(cond
[(not prev-line) 0]
[else
(define prev-indent (or (line-indent tbox prev-line) 0))
(define prev-indent (line-indent tbox prev-line))
(cond
[(left-bracket?
(line-first-visible-char tbox prev-line))

@ -5,10 +5,11 @@
(require rackunit))
(define (jsonic-token? x)
(or (eof-object? x) (token-struct? x)))
(or (eof-object? x) (string? x) (token-struct? x)))
(module+ test
(check-true (jsonic-token? eof))
(check-true (jsonic-token? "a string"))
(check-true (jsonic-token? (token 'A-TOKEN-STRUCT "hi")))
(check-false (jsonic-token? 42)))

@ -5,10 +5,11 @@
(require rackunit))
(define (token? x)
(or (eof-object? x) (token-struct? x)))
(or (eof-object? x) (string? x) (token-struct? x)))
(module+ test
(check-true (token? eof))
(check-true (token? "a string"))
(check-true (token? (token 'A-TOKEN-STRUCT "hi")))
(check-false (token? 42)))

@ -1,18 +0,0 @@
#lang br/quicklang
(module reader br
(provide (rename-out [rs read-syntax]))
(define (rs src ip)
(define toks (for/list ([tok (in-port (λ (p) (read-syntax src ip)) ip)])
tok))
(strip-context
(with-syntax ([(PT ...) toks])
#'(module _ mirror-demo
PT ...)))))
(provide (except-out (all-from-out br/quicklang) #%module-begin)
(rename-out [mb #%module-begin]))
(define-macro (mb PT ...)
#'(#%module-begin
PT ...))

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

@ -1,54 +0,0 @@
#lang br
(require racket/sequence)
(module reader br
(provide read-syntax)
(define (read-syntax path ip)
(strip-context
#`(module mod numberstring-demo
#,@(map string->number (regexp-match* #rx"." (string-trim (port->string ip))))))))
(define (ones->word num)
(case num
[(1) "one"][(2) "two"][(3) "three"][(4) "four"][(5) "five"]
[(6) "six"][(7) "seven"][(8) "eight"][(9) "nine"]))
(define (tens->word num)
(case num
[(2) "twenty"][(3) "thirty"][(4) "forty"][(5) "fifty"]
[(6) "sixty"][(7) "seventy"][(8) "eighty"][(9) "ninety"]
[else (number->string num)]))
(define (two-digit->word num)
(case num
[(10) "ten"][(11) "eleven"][(12) "twelve"][(13) "thirteen"][(14) "fourteen"]
[(15) "fifteen"][(16) "sixteen"][(17) "seventeen"][(18) "eighteen"][(19) "nineteen"]
[else (string-join (cons (tens->word (quotient num 10))
(if (positive? (modulo num 10))
(list (ones->word (modulo num 10)))
null)) "-")]))
(define (triple->string triple)
(match-define (list h t o) triple)
(string-join
(append
(if (positive? h)
(list (ones->word h) "hundred")
null)
(if (positive? t)
(list (two-digit->word (+ (* 10 t) o)))
(list (ones->word o)))) " "))
(define (ones triple) (format "~a" (triple->string triple)))
(define (thousands triple) (format "~a thousand" (triple->string triple)))
(define (millions triple) (format "~a million" (triple->string triple)))
(provide #%datum #%top-interaction (rename-out [mb #%module-begin]))
(define-macro (mb . DIGITS)
#'(#%module-begin
(define digits (list . DIGITS))
(define padded-digits (append (make-list (- 9 (length digits)) 0) digits))
(display (string-join (reverse (for/list ([triple (in-slice 3 (reverse padded-digits))]
[quantifier (list ones thousands millions)]
#:unless (equal? triple '(0 0 0)))
(quantifier (reverse triple)))) ", "))))

@ -1,2 +0,0 @@
#lang numberstring-demo
56833458

@ -1,12 +1,11 @@
#lang brag
top : (fun | app)*
fun : /"fun" var /"(" argvars /")" /"=" expr
/argvars : [var (/"," var)*]
@expr : add-or-sub
add-or-sub : [add-or-sub ("+" | "-")] mult-or-div
mult-or-div : [mult-or-div ("*" | "/")] value
@value : var | int | app | /"(" expr /")"
int : ["-"] INT
app : var /"(" [expr (/"," expr)*] /")"
top : (func-def | func-app)*
func-def : /"fun" var /"(" vars /")" /"=" expr
/vars : [var (/"," var)*]
@expr : sum
sum : [sum ("+" | "-")] product
product : [product ("*" | "/")] value
@value : var | INT | func-app | /"(" expr /")"
func-app : var /"(" [expr (/"," expr)*] /")"
@var : ID

@ -1,6 +1,6 @@
#lang br/quicklang
(require brag/support "grammar.rkt")
(provide top fun app add-or-sub mult-or-div int)
(provide (all-defined-out) #%module-begin)
(module+ reader
(provide read-syntax))
@ -8,41 +8,35 @@
(define-lex-abbrev reserved-toks
(:or "fun" "(" ")" "=" "+" "*" "/" "-" ","))
(define-lex-abbrev digit (char-set "0123456789"))
(define tokenize-1
(define tokenize
(lexer
[whitespace (token lexeme #:skip? #t)]
[(:or (from/stop-before "#" "\n")
(from/to "/*" "*/")) (token 'COMMENT #:skip? #t)]
[(:or (from/to "//" "\n") (from/to "/*" "*/")) (token 'COMMENT #:skip? #t)]
[whitespace (tokenize input-port)]
[reserved-toks lexeme]
[(:+ digit) (token 'INT (string->number lexeme))]
[(:+ alphabetic) (token 'ID (string->symbol lexeme))]))
[alphabetic (token 'ID (string->symbol lexeme))]
[(:+ (char-set "0123456789")) (token 'INT (string->number lexeme))]))
(define-macro top #'#%module-begin)
(define-macro top #'begin)
(define-macro (fun VAR (ARGVAR ...) EXPR)
#'(define (VAR ARGVAR ...) EXPR))
(define-macro (func-def VAR VARS EXPR)
#'(define (VAR . VARS) EXPR))
(define-macro-cases add-or-sub
(define-macro-cases sum
[(_ LEFT "+" RIGHT) #'(+ LEFT RIGHT)]
[(_ LEFT "-" RIGHT) #'(- LEFT RIGHT)]
[(_ OTHER) #'OTHER])
(define-macro-cases mult-or-div
[(_ LEFT "*" RIGHT) #'(* LEFT RIGHT)]
[(_ LEFT "/" RIGHT) #'(/ LEFT RIGHT)]
(define-macro-cases product
[(_ LEFT OP-STR RIGHT)
(with-syntax ([OP (string->symbol (syntax->datum #'OP-STR))])
#'(OP LEFT RIGHT))]
[(_ OTHER) #'OTHER])
(define-macro-cases int
[(_ VAL) #'VAL]
[(_ "-" VAL) #'(- VAL)])
(define-macro app #'#%app)
(define-macro func-app #'#%app)
(define (read-syntax src ip)
(define parse-tree (parse src (λ () (tokenize-1 ip))))
(strip-bindings
(define parse-tree (parse (λ () (tokenize ip))))
(strip-context
(with-syntax ([PT parse-tree])
#'(module precalc-mod precalc-demo
#'(module mod-name precalc-demo
PT))))

@ -1,15 +1,15 @@
#lang precalc-demo
fun f(x, y, z) = x + x + x * (y + y) + y * z - z - z
fun g(z) = f(z, z, z) # line comment
g(-10) # = 300
fun g(z) = f(z, z, z) // line comment
g(10) // 300
fun h() = g(10)
h() # = 300
h() // also 300
fun k(x) = x / 10 / 10 / (x / x)
k(h()) # = 3
k(-10 * (15 + 3 * 5)) # = -3
k(h()) // 3
k(10 * (15 + 3 * 5)) // 3
/*
multiline comment

@ -1,13 +0,0 @@
#lang br
(module reader br
(provide read-syntax)
(define (read-syntax name port)
(define s-exprs (let loop ([toks null])
(define tok (read port))
(if (eof-object? tok)
(reverse toks)
(loop (cons tok toks)))))
(strip-bindings
(with-syntax ([(EXPR ...) s-exprs])
#'(module read-only-mod br
EXPR ...)))))

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

@ -1,138 +0,0 @@
#lang br
(require racket/stxparam)
(provide (all-defined-out)
#%app #%top #%datum #%top-interaction)
(define-macro top #'#%module-begin)
(define-macro-cases ternary
[(_ EXPR) #'EXPR]
[(_ COND TRUE-EXPR FALSE-EXPR) #'(if COND TRUE-EXPR FALSE-EXPR)])
(define-macro-cases logical-or
[(_ VAL) #'VAL]
[(_ L "||" R) #'(or L R)])
(define-macro-cases logical-and
[(_ VAL) #'VAL]
[(_ L "&&" R) #'(and L R)])
(define-macro (my-app ID ARG ...)
#'(error 'boom))
(define-macro-cases var
[(_ ID VAL) #'(define ID VAL)]
[(_ ID ... VAL) #'(begin (define ID VAL) ...)])
(define (add/concat . xs)
(cond
[(andmap number? xs) (let ([sum (apply + xs)])
(if (and (integer? sum) (inexact? sum))
(inexact->exact sum)
sum))]
[(ormap string? xs) (string-join (map ~a xs) "")]))
(define-macro-cases add-or-sub
[(_ LEFT "+" RIGHT) #'(add/concat LEFT RIGHT)]
[(_ LEFT "-" RIGHT) #'(- LEFT RIGHT)]
[(_ OTHER) #'OTHER])
(define-macro-cases mult-or-div
[(_ LEFT "*" RIGHT) #'(* LEFT RIGHT)]
[(_ LEFT "/" RIGHT) #'(/ LEFT RIGHT)]
[(_ OTHER) #'OTHER])
(define-macro (object (K V) ...)
#'(make-hash (list (cons K V) ...)))
(define-syntax-parameter return
(λ (stx) (error 'not-parameterized)))
(define-macro (fun (ARG ...) STMT ...)
(syntax/loc caller-stx
(λ (ARG ...)
(let/cc return-cc
(syntax-parameterize ([return (make-rename-transformer #'return-cc)])
(void) STMT ...)))))
(define-macro (defun ID (ARG ...) STMT ...)
#'(define ID (fun (ARG ...) STMT ...)))
(define (resolve-deref base . keys)
(for/fold ([val base])
([key (in-list keys)])
(cond
[(and
(hash? val)
(cond
[(hash-ref val key #f)]
[(hash-ref val (symbol->string key) #f)]
[else #f]))]
[else (error 'deref-failure)])))
(define-macro (deref (BASE KEY ...))
#'(resolve-deref BASE 'KEY ...))
(define-macro app #'#%app)
(define-macro-cases if-else
[(_ COND TSTMT ... "else" FSTMT ...) #'(cond
[COND TSTMT ...]
[else FSTMT ...])]
[(_ COND STMT ...) #'(when COND STMT ...)])
(define-macro-cases equal-or-not
[(_ VAL) #'VAL]
[(_ L "==" R) #'(equal? L R)]
[(_ L "!=" R) #'(not (equal? L R))])
(define-macro-cases gt-or-lt
[(_ VAL) #'VAL]
[(_ L "<" R) #'(< L R)]
[(_ L "<=" R) #'(<= L R)]
[(_ L ">" R) #'(> L R)]
[(_ L ">=" R) #'(>= L R)])
(define-macro (while COND STMT ...)
#'(let loop ()
(when COND
STMT ...
(loop))))
(define (alert x) (displayln (format "ALERT! ~a" x)))
#;(require racket/gui)
#;(define (alert text)
(define dialog (instantiate dialog% ("Alert")))
(new message% [parent dialog] [label text])
(define panel (new horizontal-panel% [parent dialog]
[alignment '(center center)]))
(new button% [parent panel] [label "Ok"]
[callback (lambda (button event)
(send dialog show #f))])
(send dialog show #t))
(define-macro-cases increment
[(_ ID) #'ID]
[(_ "++" ID) #'(let ()
(set! ID (add1 ID))
ID)]
[(_ "--" ID) #'(let ()
(set! ID (sub1 ID))
ID)]
[(_ ID "++") #'(begin0
ID
(set! ID (add1 ID)))]
[(_ ID "--") #'(begin0
ID
(set! ID (sub1 ID)))])
(define-macro-cases reassignment
[(_ ID) #'ID]
[(_ ID "+=" EXPR) #'(let ()
(set! ID (+ ID EXPR))
ID)]
[(_ ID "-=" EXPR) #'(let ()
(set! ID (- ID EXPR))
ID)])

@ -1,31 +0,0 @@
#lang brag
top : @statement*
statement : (var | expr | return | defun) /";" | if-else | while
var : /"var" (varname /"=")+ expr
@expr : reassignment
reassignment : ID [("+=" | "-=") expr] | ternary
ternary : expr /"?" expr /":" expr | logical-or
logical-or : [logical-or "||"] logical-and
logical-and : [logical-and "&&"] equal-or-not
equal-or-not : [equal-or-not ("!=" | "==")] gt-or-lt
gt-or-lt : [gt-or-lt ("<" | "<=" | ">" | ">=")] add-or-sub
add-or-sub : [add-or-sub ("+" | "-")] mult-or-div
mult-or-div : [mult-or-div ("*" | "/")] value
@value : NUMBER | STRING | object
| fun | app | increment | varname | /"(" expr /")"
increment : ("++" | "--") varname | varname ("++" | "--")
object : /"{" @kvs /"}"
kvs : [kv (/"," kv)*]
/kv : expr /":" expr
defun : /"function" ID /"(" varnames /")" @block
fun : /"function" /"(" varnames /")" @block
/varnames : [varname (/"," varname)*]
@varname : ID | deref
deref : DEREF
block : /"{" @statement* /"}"
return : /"return" expr
app : varname /"(" @exprs /")"
exprs : [expr (/"," expr)*]
if-else : /"if" /"(" expr /")" @block ["else" @block]
while : /"while" /"(" expr /")" @block

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

@ -1,43 +0,0 @@
#lang br/quicklang
(require "grammar.rkt" brag/support)
(module+ reader
(provide read-syntax))
(define-lex-abbrev reserved-toks
(:or "var" "=" ";" "{" "}" "//" "/*" "*/"
"+" "*" "/" "-"
"'" "\""
":" "," "(" ")"
"if" "else" "while" "?"
"==" "!=" "<=" "<" ">=" ">" "&&" "||"
"function"
"return" "++" "--" "+=" "-="))
(define-lex-abbrev digits (:+ (char-set "0123456789")))
(define tokenize-1
(lexer-srcloc
[(:or (from/stop-before "//" "\n")
(from/to "/*" "*/")) (token 'COMMENT #:skip? #t)]
[reserved-toks lexeme]
[(:seq (:? "-") (:or (:seq (:? digits) "." digits)
(:seq digits (:? "."))))
(token 'NUMBER (string->number lexeme))]
[(:seq (:+ (:- (:or alphabetic punctuation digits) reserved-toks)))
(if (string-contains? lexeme ".")
(token 'DEREF (map string->symbol (string-split lexeme ".")))
(token 'ID (string->symbol 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)
(port-count-lines! ip)
(lexer-file-path ip)
(define parse-tree (parse src (λ () (tokenize-1 ip))))
(strip-bindings
(with-syntax ([PT parse-tree])
#'(module scriptish-mod scriptish-demo/expander
PT))))

@ -1,21 +0,0 @@
#lang scriptish-demo
-1; // line comment
10 ;
/* multi
// line
comment */
2;
var al = -.123;
var bo = "foo";
var cy = 1.;
var da = 'bar';
al;bo;cy;da;
cy + cy + cy;
al+cy*al-cy/100;
cy++;
cy + cy + bo + da;
bo+cy+cy+da;

@ -1,34 +0,0 @@
#lang scriptish-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:...test.rkt:11:12>
thing.bar(3); // prints 18
if ( thing.foo == 42 ) {
// prints "The correct answer is 42"
alert("The correct answer is " + thing.foo);
} else {
alert("Nope");
}
var idx = 0;
while ( idx != 50 ) {
if ( thing.bar(idx) == 35 ) {
// prints "Calamity at 20!"
alert("Calamity at " + idx + "!");
}
idx++;
}

@ -7,7 +7,7 @@
(for/list ([tok (in-port read-char ip)])
tok))
(define (parse src toks)
(define (parse toks)
(for/list ([tok (in-list toks)])
(define int (char->integer tok))
(for/list ([bit (in-range 7)])
@ -17,13 +17,8 @@
(define (read-syntax src ip)
(define toks (tokenize ip))
(define parse-tree (parse src toks))
(strip-bindings
(define parse-tree (parse toks))
(strip-context
(with-syntax ([PT parse-tree])
#'(module tacofied taco-compiler-demo
PT))))
(define-macro (mb PT)
#'(#%module-begin
(for-each displayln 'PT)))
(provide (rename-out [mb #%module-begin]))
#'(module tacofied racket
(for-each displayln 'PT)))))

@ -7,7 +7,7 @@
(for/list ([tok (in-port read ip)])
tok))
(define (parse src toks)
(define (parse toks)
(for/list ([tok (in-list toks)])
(integer->char
(for/sum ([val (in-list tok)]
@ -17,13 +17,8 @@
(define (read-syntax src ip)
(define toks (tokenize ip))
(define parse-tree (parse src toks))
(define parse-tree (parse toks))
(strip-context
(with-syntax ([PT parse-tree])
#'(module untaco taco-decompiler-demo
PT))))
(define-macro (mb PT)
#'(#%module-begin
(display (list->string 'PT))))
(provide (rename-out [mb #%module-begin]))
#'(module untaco racket
(display (list->string 'PT))))))

@ -7,7 +7,7 @@
(for/list ([tok (in-port read ip)])
tok))
(define (parse src toks)
(define (parse toks)
(for/list ([tok (in-list toks)])
(integer->char
(for/sum ([val (in-list tok)]
@ -17,7 +17,7 @@
(define (read-syntax src ip)
(define toks (tokenize ip))
(define parse-tree (parse src toks))
(define parse-tree (parse toks))
(define src-string (list->string parse-tree))
(define racket-toks
(for/list ([tok (in-port read (open-input-string src-string))])

@ -1,14 +1,11 @@
#lang br/quicklang
(require brag/support "grammar.rkt")
(provide taco-program taco-leaf
taco not-a-taco
show
#%module-begin)
(provide (all-from-out br/quicklang) (all-defined-out))
(module+ reader
(provide read-syntax))
(define (tokenize-1 ip)
(define (tokenize ip)
(define lex
(lexer
["#$" lexeme]
@ -28,13 +25,10 @@
(define (not-a-taco) 0)
(define (show pt)
(display (apply string pt)))
(define (read-syntax src ip)
(define token-thunk (λ () (tokenize-1 ip)))
(define parse-tree (parse src token-thunk))
(define token-thunk (λ () (tokenize ip)))
(define parse-tree (parse token-thunk))
(strip-context
(with-syntax ([PT parse-tree])
#'(module winner taco-victory-demo
(show PT)))))
(display (apply string PT))))))

@ -8,7 +8,7 @@
(for/list ([tok (in-port read-char ip)])
tok))
(define (parse src toks)
(define (parse toks)
(define parse-tree-datum (parse-to-datum toks))
(for/list ([leaf (in-list (cdr parse-tree-datum))])
(integer->char
@ -17,15 +17,11 @@
#:when (equal? val '(taco)))
(expt 2 power)))))
(define (read-syntax src ip)
(define toks (tokenize ip))
(define parse-tree (parse src toks))
(define parse-tree (parse toks))
(strip-context
(with-syntax ([PT parse-tree])
#'(module tacogram-mod tacogram-demo
PT))))
(define-macro (mb PT)
#'(#%module-begin
(display (list->string 'PT))))
(provide (rename-out [mb #%module-begin]))
#'(module untaco racket
(display (list->string 'PT))))))

@ -1,5 +1,5 @@
#lang br/quicklang
(require brag/support)
(require brag/support racket/sequence)
(module+ reader
(provide read-syntax))
@ -11,31 +11,24 @@
[any-char (lex input-port)]))
(define (tokenize ip)
(for/list ([tok (in-port lex ip)])
(define toklets
(for/list ([toklet (in-port lex ip)])
toklet))
(for/list ([tok (in-slice 7 toklets)])
tok))
(define (parse src toks)
(define heptatoks
(let loop ([toks toks][acc null])
(if (empty? toks)
(reverse acc)
(loop (drop toks 7) (cons (take toks 7) acc)))))
(for/list ([heptatok (in-list heptatoks)])
(define (parse toks)
(for/list ([tok (in-list toks)])
(integer->char
(for/sum ([val (in-list heptatok)]
(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 (parse src toks))
(define parse-tree (parse toks))
(strip-context
(with-syntax ([PT parse-tree])
#'(module taco-mod tacopocalypse-demo
PT))))
(define-macro (my-module-begin PT)
#'(#%module-begin
(display (list->string 'PT))))
(provide (rename-out [my-module-begin #%module-begin]))
#'(module untaco racket
(display (list->string 'PT))))))

@ -1,38 +0,0 @@
#lang txtadv-demo
===VERBS===
north, n
"go north"
south, s
"go south"
get _, grab _, take _
"take"
===THINGS===
---cactus---
get
"You win!"
===PLACES===
---meadow---
"Welcome to the Cactus Game! You're standing in a meadow. There is a desert to the south."
[]
south
desert
---desert---
"You're in a desert. There is nothing for miles around."
[cactus]
north
meadow
===START===
meadow

@ -1,5 +0,0 @@
#lang racket/base
(module reader racket/base
(require "reader.rkt")
(provide (all-from-out "reader.rkt")))

@ -1,6 +1,6 @@
#lang brag
txtadv-program : [verb-section] [everywhere-section] [things-section] [places-section] start-section
txtadv-program : verb-section everywhere-section things-section places-section start-section
verb-section : /"===VERBS===" verb-item+

@ -12,11 +12,9 @@
(define-macro-cases report-datum
[(_ STX-EXPR) #`(report-datum STX-EXPR #,(syntax->datum #'STX-EXPR))]
[(_ STX-EXPR NAME)
#'(let ([stx STX-EXPR])
(eprintf "~a = ~v\n" 'NAME (if (eof-object? stx)
stx
(syntax->datum stx)))
stx)])
#'(let ()
(eprintf "~a = ~v\n" 'NAME (syntax->datum STX-EXPR))
STX-EXPR)])
(define-macro (define-multi-version MULTI-NAME NAME)
#'(define-macro (MULTI-NAME X (... ...))

@ -1,6 +1,19 @@
#lang racket/base
(require racket/function (for-syntax racket/base syntax/parse) br/macro)
(provide (all-defined-out) (all-from-out br/macro))
(require racket/function
(for-syntax racket/base
syntax/parse
br/private/generate-literals
syntax/define))
(provide (all-defined-out)
(for-syntax with-shared-id))
(module+ test (require rackunit))
(begin-for-syntax
;; expose the caller context within br:define macros with syntax parameter
(require (for-syntax racket/base) racket/stxparam)
(provide caller-stx)
(define-syntax-parameter caller-stx (λ(stx) (error 'caller-stx-not-parameterized))))
(define-syntax (define-cases stx)
(syntax-parse stx
@ -16,3 +29,217 @@
'define-cases
"no matching case for calling pattern"
(syntax->datum stx))]))
(module+ test
(define-cases f
[(_ arg) (add1 arg)]
[(_ arg1 arg2) (+ arg1 arg2)]
[(_ . any) 'boing])
(check-equal? (f 42) 43)
(check-equal? (f 42 5) 47)
(check-equal? (f 42 5 'zonk) 'boing)
(define-cases f-one-arg
[(_ arg) (add1 arg)])
(check-exn exn:fail:contract:arity? (λ _ (f-one-arg 1 2 3))))
(define-syntax-rule (debug-define-macro (ID . PAT-ARGS) BODY)
(define-macro (ID . PAT-ARGS)
#`(begin
(for-each displayln
(list
(format "input pattern = #'~a" '#,'(ID . PAT-ARGS))
(format "output pattern = #'~a" (cadr '#,'BODY))
(format "invoked as = ~a" (syntax->datum #'(ID . PAT-ARGS)))
(format "expanded as = ~a" '#,(syntax->datum BODY))
(format "evaluated as = ~a" #,BODY)))
#,BODY)))
(module+ test
(require racket/port)
(parameterize ([current-output-port (open-output-nowhere)])
(check-equal? (let ()
(debug-define-macro (foo X Y Z)
#'(apply + (list X Y Z)))
(foo 1 2 3)) 6)
(check-equal? (let ()
(debug-define-macro (foo X ...) #'(apply * (list X ...)))
(foo 10 11 12)) 1320)))
(begin-for-syntax
(begin-for-syntax
(require (for-syntax racket/base))
(define-syntax-rule (make-shared-syntax-macro caller-stx)
#'(syntax-rules stx
[(_ form)
#'(datum->syntax caller-stx (if (syntax? form)
(syntax-e form)
form))]))))
(module+ test
(define-macro (dirty-maker ARG)
(with-syntax ([dirty-bar (datum->syntax caller-stx 'dirty-bar)])
#'(define dirty-bar (* ARG 2))))
(dirty-maker 42)
(check-equal? dirty-bar 84))
(begin-for-syntax
(define-syntax-rule (with-shared-id (id ...) . body)
(with-syntax ([id (datum->syntax caller-stx 'id)] ...)
. body)))
;; `syntax-parse` classes shared by `define-macro` and `define-macro-cases`
(begin-for-syntax
(require syntax/parse)
(define-syntax-class syntaxed-id
#:literals (syntax quasisyntax)
#:description "id in syntaxed form"
(pattern ([~or syntax quasisyntax] name:id)))
(define-syntax-class syntaxed-thing
#:literals (syntax quasisyntax)
#:description "some datum in syntaxed form"
(pattern ([~or syntax quasisyntax] thing:expr)))
(define-syntax-class else-clause
#:literals (else)
(pattern [else . body:expr]))
(define-syntax-class transformer-func
#:literals (lambda λ)
(pattern ([~or lambda λ] (arg:id) . body:expr))))
(define-syntax (define-macro stx)
(syntax-parse stx
[(_ id:id stxed-id:syntaxed-id)
#'(define-syntax id (make-rename-transformer stxed-id))]
[(_ id:id func:transformer-func)
#'(define-syntax id func)]
[(_ id:id func-id:id)
#'(define-syntax id func-id)]
[(_ id:id stxed-thing:syntaxed-thing)
#'(define-macro id (λ (stx) stxed-thing))]
[(_ (id:id . patargs:expr) . body:expr)
(with-syntax ([id (syntax-property #'id 'caller 'define-macro)])
#'(define-macro-cases id [(id . patargs) (begin . body)]))]
[else (raise-syntax-error
'define-macro
"no matching case for calling pattern"
(syntax->datum stx))]))
(define-syntax (define-macro-cases stx)
(define (error-source stx) (or (syntax-property stx 'caller) 'define-macro-cases))
(syntax-parse stx
[(_ id:id)
(raise-syntax-error (error-source #'id) "no cases given" (syntax->datum #'id))]
[(_ id:id leading-pat:expr ... else-pat:else-clause trailing-pat0:expr trailing-pat:expr ...)
(raise-syntax-error (error-source #'id) "`else` clause must be last" (syntax->datum #'id))]
[(_ id:id (pat:expr . result-exprs:expr) ... else-clause:else-clause)
(unless (ellipses-follow-wildcards-or-subpatterns? #'(pat ...))
(raise-syntax-error (error-source #'id) "ellipsis in pattern can only appear after wildcard or subpattern" (syntax->datum stx)))
(with-syntax ([(PAT ...) (map (λ (x) (literalize-pat x #'~literal)) (syntax->list #'(pat ...)))])
#'(define-macro id
(λ (stx)
(define result
(syntax-parameterize ([caller-stx (make-rename-transformer #'stx)])
(syntax-parse (syntax-case stx () [any #'any])
[PAT . result-exprs] ...
else-clause)))
(if (syntax? result)
result
(datum->syntax #'id result)))))]
[(_ id:id pat-clause:expr ...) ; macro without `else` clause will reach this branch
#'(define-macro-cases id
pat-clause ...
[else (raise-syntax-error
'id
"no matching case for calling pattern"
(syntax->datum caller-stx))])]
[else (raise-syntax-error
(error-source #'id)
"no matching case for calling pattern"
(syntax->datum stx))]))
(module+ test
(define-macro plus (λ (stx) #'+))
(check-equal? (plus 42) +)
(define-macro plusser #'plus)
(check-equal? (plusser 42) +)
(check-equal? plusser +)
(define-macro (times [nested ARG]) #`(* ARG ARG))
(check-equal? (times [nested 10]) 100)
(define-macro timeser #'times)
(check-equal? (timeser [nested 12]) 144)
(define-macro fortytwo #`42)
(check-equal? fortytwo 42)
(check-equal? (let ()
(define-macro (foo X)
(with-syntax ([zam #'+])
#'(zam X X))) (foo 42)) 84)
(begin
(define-macro (redefine ID) #'(define ID 42))
(redefine zoombar)
(check-equal? zoombar 42))
;; use caller-stx parameter to introduce identifier unhygienically
(define-macro (zam ARG1 ARG2 ARG3)
(with-syntax ([dz (datum->syntax caller-stx 'dirty-zam)])
#`(define dz 'got-dirty-zam)))
(zam 'this 'that 42)
(check-equal? dirty-zam 'got-dirty-zam)
(define-macro (add X) #'(+ X X))
(check-equal? (add 5) 10)
(define-macro (add-b 9X) #'(+ 9X 9X))
(check-equal? (add-b 5) 10)
(define-macro-cases add-again [(_ X) #'(+ X X)])
(check-equal? (add-again 5) 10)
(define-macro-cases add-3rd [(_ X) #'(+ X X)])
(check-equal? (add-3rd 5) 10)
(define-macro add-4th #'add-3rd)
(check-equal? (add-4th 5) 10)
(define foo-val 'got-foo-val)
(define (foo-func) 'got-foo-func)
(define-macro-cases op
[(_ "+") #''got-plus]
[(_ ARG) #''got-something-else]
[(_) #'(foo-func)]
[_ #'foo-val])
(check-equal? (op "+") 'got-plus)
(check-equal? (op 42) 'got-something-else)
(check-equal? (op) 'got-foo-func)
(check-equal? op 'got-foo-val)
(define-macro-cases elseop
[(_ ARG) #''got-arg]
[else #''got-else])
(check-equal? (elseop "+") 'got-arg)
(check-equal? (elseop "+" 42) 'got-else)
(check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases no-cases))))
(check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases badelseop
[else #''got-else]
[(_ _arg) #''got-arg]))))
(define-macro-cases no-else-macro
[(_ ARG) #''got-arg])
(check-exn exn:fail:syntax? (λ _ (expand-once #'(no-else-macro 'arg1 'arg2)))))
(define-macro (define-unhygienic-macro (ID PAT ...) BODY ... STX-OBJECT)
#'(define-macro (ID PAT ...)
BODY ...
(datum->syntax caller-stx (syntax->datum STX-OBJECT))))

@ -1,9 +0,0 @@
#lang info
;; for unknown reason "indent.rkt"
;; started causing CI failures
;; consistently on 6.7, 7.7CS, 7.8CS, 7.9CS
;; I assume it has something to do with the fact that
;; it imports `framework` and `racket/gui`,
;; OTOH why does it fail in these?
(define test-omit-paths '("indent.rkt"))

@ -23,20 +23,16 @@
(provide (rename-out
[br-read read]
[br-read-syntax read-syntax]
[brr-mod:get-info get-info]))
[at:get-info get-info]))
(module br-reader syntax/module-reader
(module at-reader syntax/module-reader
#:language 'br
#:info br-get-info
#:read my-read
#:read-syntax my-read-syntax
(require br/get-info (prefix-in at: scribble/reader))
(define (my-read ip) (syntax->datum (my-read-syntax ip)))
(define (my-read-syntax src ip)
(parameterize ([current-readtable (at:make-at-readtable #:command-char #\◊)])
(read-syntax src ip))))
#:read at:read
#:read-syntax at:read-syntax
(require br/get-info (prefix-in at: scribble/reader)))
(require debug/reader (prefix-in brr-mod: 'br-reader))
(require debug/reader (prefix-in at: 'at-reader))
#|
Use wrap-reader on the whole-module read function that would be exported
@ -44,5 +40,5 @@ by the reader module, not the single-expression read function like
at:read-syntax that you deal with within syntax/module-reader or normal use.
|#
(define br-read (wrap-reader brr-mod:read))
(define br-read-syntax (wrap-reader brr-mod:read-syntax)))
(define br-read (wrap-reader at:read))
(define br-read-syntax (wrap-reader at:read-syntax)))

@ -71,8 +71,8 @@
(define end (+ current-idx how-many))
(bytes-copy! bs 0 current-bs current-idx end)
(set! current-idx end)
(set! col (+ (or col 0) how-many))
(set! pos (+ (or pos 0) how-many))
(set! col (+ col how-many))
(set! pos (+ pos how-many))
(unless (< current-idx (bytes-length current-bs))
(consume-ss!))
how-many]

@ -1,7 +1,7 @@
#lang racket/base
(require (for-syntax
racket/base
"private/generate-literals.rkt")
br/private/generate-literals)
racket/list
racket/match
racket/syntax
@ -9,8 +9,8 @@
syntax/stx
syntax/strip-context
syntax/parse
"macro.rkt"
"private/syntax-flatten.rkt")
br/define
br/private/syntax-flatten)
(provide (all-defined-out)
syntax-flatten
stx-map

@ -2,12 +2,9 @@
(define collection 'multi)
(define version "1.5")
(define version "1.4")
;; base v6.7 dependency needs to be called 6.6.0.900
;; due to strange little bug in `raco pkg install`
(define deps '(["base" #:version "6.6.0.900"]
"beautiful-racket-macro"
(define deps '(["base" #:version "6.3"]
"at-exp-lib"
"sugar"
"debug"

@ -1,245 +0,0 @@
#lang racket/base
(require racket/function
(for-syntax racket/base
syntax/parse
"private/generate-literals.rkt"
syntax/define))
(provide (all-defined-out)
(for-syntax with-shared-id))
(module+ test (require rackunit))
(begin-for-syntax
;; expose the caller context within br:define macros with syntax parameter
(require (for-syntax racket/base) racket/stxparam)
(provide caller-stx)
(define-syntax-parameter caller-stx (λ(stx) (error 'caller-stx-not-parameterized))))
(define-syntax (define-cases stx)
(syntax-parse stx
#:literals (syntax)
[(_ id:id)
(raise-syntax-error 'define-cases "no cases given" (syntax->datum #'id))]
[(_ id:id [(_ . pat-args:expr) . body:expr] ...)
#'(define id
(case-lambda
[pat-args . body] ...
[rest-pat (apply raise-arity-error 'id (normalize-arity (map length '(pat-args ...))) rest-pat)]))]
[else (raise-syntax-error
'define-cases
"no matching case for calling pattern"
(syntax->datum stx))]))
(module+ test
(define-cases f
[(_ arg) (add1 arg)]
[(_ arg1 arg2) (+ arg1 arg2)]
[(_ . any) 'boing])
(check-equal? (f 42) 43)
(check-equal? (f 42 5) 47)
(check-equal? (f 42 5 'zonk) 'boing)
(define-cases f-one-arg
[(_ arg) (add1 arg)])
(check-exn exn:fail:contract:arity? (λ _ (f-one-arg 1 2 3))))
(define-syntax-rule (debug-define-macro (ID . PAT-ARGS) BODY)
(define-macro (ID . PAT-ARGS)
#`(begin
(for-each displayln
(list
(format "input pattern = #'~a" '#,'(ID . PAT-ARGS))
(format "output pattern = #'~a" (cadr '#,'BODY))
(format "invoked as = ~a" (syntax->datum #'(ID . PAT-ARGS)))
(format "expanded as = ~a" '#,(syntax->datum BODY))
(format "evaluated as = ~a" #,BODY)))
#,BODY)))
(module+ test
(require racket/port)
(parameterize ([current-output-port (open-output-nowhere)])
(check-equal? (let ()
(debug-define-macro (foo X Y Z)
#'(apply + (list X Y Z)))
(foo 1 2 3)) 6)
(check-equal? (let ()
(debug-define-macro (foo X ...) #'(apply * (list X ...)))
(foo 10 11 12)) 1320)))
(begin-for-syntax
(begin-for-syntax
(require (for-syntax racket/base))
(define-syntax-rule (make-shared-syntax-macro caller-stx)
#'(syntax-rules stx
[(_ form)
#'(datum->syntax caller-stx (if (syntax? form)
(syntax-e form)
form))]))))
(module+ test
(define-macro (dirty-maker ARG)
(with-syntax ([dirty-bar (datum->syntax caller-stx 'dirty-bar)])
#'(define dirty-bar (* ARG 2))))
(dirty-maker 42)
(check-equal? dirty-bar 84))
(begin-for-syntax
(define-syntax-rule (with-shared-id (id ...) . body)
(with-syntax ([id (datum->syntax caller-stx 'id)] ...)
. body)))
;; `syntax-parse` classes shared by `define-macro` and `define-macro-cases`
(begin-for-syntax
(require syntax/parse)
(define-syntax-class syntaxed-id
#:literals (syntax quasisyntax)
#:description "id in syntaxed form"
(pattern ([~or syntax quasisyntax] name:id)))
(define-syntax-class syntaxed-thing
#:literals (syntax quasisyntax)
#:description "some datum in syntaxed form"
(pattern ([~or syntax quasisyntax] thing:expr)))
(define-syntax-class else-clause
#:literals (else)
(pattern [else . body:expr]))
(define-syntax-class transformer-func
#:literals (lambda λ)
(pattern ([~or lambda λ] (arg:id) . body:expr))))
(define-syntax (define-macro stx)
(syntax-parse stx
[(_ id:id stxed-id:syntaxed-id)
#'(define-syntax id (make-rename-transformer stxed-id))]
[(_ id:id func:transformer-func)
#'(define-syntax id func)]
[(_ id:id func-id:id)
#'(define-syntax id func-id)]
[(_ id:id stxed-thing:syntaxed-thing)
#'(define-macro id (λ (stx) stxed-thing))]
[(_ (id:id . patargs:expr) . body:expr)
(with-syntax ([id (syntax-property #'id 'caller 'define-macro)])
#'(define-macro-cases id [(id . patargs) (begin . body)]))]
[else (raise-syntax-error
'define-macro
"no matching case for calling pattern"
(syntax->datum stx))]))
(define-syntax (define-macro-cases stx)
(define (error-source stx) (or (syntax-property stx 'caller) 'define-macro-cases))
(syntax-parse stx
[(_ id:id)
(raise-syntax-error (error-source #'id) "no cases given" (syntax->datum #'id))]
[(_ id:id leading-pat:expr ... else-pat:else-clause trailing-pat0:expr trailing-pat:expr ...)
(raise-syntax-error (error-source #'id) "`else` clause must be last" (syntax->datum #'id))]
[(_ id:id (pat:expr . result-exprs:expr) ... else-clause:else-clause)
(unless (ellipses-follow-wildcards-or-subpatterns? #'(pat ...))
(raise-syntax-error (error-source #'id) "ellipsis in pattern can only appear after wildcard or subpattern" (syntax->datum stx)))
(with-syntax ([(PAT ...) (map (λ (x) (literalize-pat x #'~literal)) (syntax->list #'(pat ...)))])
#'(define-macro id
(λ (stx)
(define result
(syntax-parameterize ([caller-stx (make-rename-transformer #'stx)])
(syntax-parse (syntax-case stx () [any #'any])
[PAT . result-exprs] ...
else-clause)))
(if (syntax? result)
result
(datum->syntax #'id result)))))]
[(_ id:id pat-clause:expr ...) ; macro without `else` clause will reach this branch
#'(define-macro-cases id
pat-clause ...
[else (raise-syntax-error
'id
"no matching case for calling pattern"
(syntax->datum caller-stx))])]
[else (raise-syntax-error
(error-source #'id)
"no matching case for calling pattern"
(syntax->datum stx))]))
(module+ test
(define-macro plus (λ (stx) #'+))
(check-equal? (plus 42) +)
(define-macro plusser #'plus)
(check-equal? (plusser 42) +)
(check-equal? plusser +)
(define-macro (times [nested ARG]) #`(* ARG ARG))
(check-equal? (times [nested 10]) 100)
(define-macro timeser #'times)
(check-equal? (timeser [nested 12]) 144)
(define-macro fortytwo #`42)
(check-equal? fortytwo 42)
(check-equal? (let ()
(define-macro (foo X)
(with-syntax ([zam #'+])
#'(zam X X))) (foo 42)) 84)
(begin
(define-macro (redefine ID) #'(define ID 42))
(redefine zoombar)
(check-equal? zoombar 42))
;; use caller-stx parameter to introduce identifier unhygienically
(define-macro (zam ARG1 ARG2 ARG3)
(with-syntax ([dz (datum->syntax caller-stx 'dirty-zam)])
#`(define dz 'got-dirty-zam)))
(zam 'this 'that 42)
(check-equal? dirty-zam 'got-dirty-zam)
(define-macro (add X) #'(+ X X))
(check-equal? (add 5) 10)
(define-macro (add-b 9X) #'(+ 9X 9X))
(check-equal? (add-b 5) 10)
(define-macro-cases add-again [(_ X) #'(+ X X)])
(check-equal? (add-again 5) 10)
(define-macro-cases add-3rd [(_ X) #'(+ X X)])
(check-equal? (add-3rd 5) 10)
(define-macro add-4th #'add-3rd)
(check-equal? (add-4th 5) 10)
(define foo-val 'got-foo-val)
(define (foo-func) 'got-foo-func)
(define-macro-cases op
[(_ "+") #''got-plus]
[(_ ARG) #''got-something-else]
[(_) #'(foo-func)]
[_ #'foo-val])
(check-equal? (op "+") 'got-plus)
(check-equal? (op 42) 'got-something-else)
(check-equal? (op) 'got-foo-func)
(check-equal? op 'got-foo-val)
(define-macro-cases elseop
[(_ ARG) #''got-arg]
[else #''got-else])
(check-equal? (elseop "+") 'got-arg)
(check-equal? (elseop "+" 42) 'got-else)
(check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases no-cases))))
(check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases badelseop
[else #''got-else]
[(_ _arg) #''got-arg]))))
(define-macro-cases no-else-macro
[(_ ARG) #''got-arg])
(check-exn exn:fail:syntax? (λ _ (expand-once #'(no-else-macro 'arg1 'arg2)))))
(define-macro (define-unhygienic-macro (ID PAT ...) BODY ... STX-OBJECT)
#'(define-macro (ID PAT ...)
BODY ...
(datum->syntax caller-stx (syntax->datum STX-OBJECT))))

@ -1,11 +0,0 @@
#lang info
(define collection 'multi)
(define version "1.5")
;; base v6.7 dependency needs to be called 6.6.0.900
;; due to strange little bug in `raco pkg install`
(define deps '(["base" #:version "6.6.0.900"]))
(define build-deps '("rackunit-lib"))

@ -19,13 +19,6 @@ This library provides the @tt{#lang br} teaching language used in the book, as w
This library is designed to smooth over some of the small idiosyncrasies and inconsistencies in Racket, so that those new to Racket are more likely to say ``ah, that makes sense'' rather than ``huh? what?''
@section{Installation}
If you want all the code & documentation, install the package @racket[beautiful-racket].
If you just want the code modules (for instance, for use as a dependency in another project) install the package @racket[beautiful-racket-lib].
If you just want the @racketmodname[br/macro] and @racketmodname[br/syntax] modules, install the package @racket[beautiful-racket-macro].
@section{Conditionals}
@ -177,8 +170,6 @@ A variant of @racket[report] for use with @secref["stx-obj" #:doc '(lib "scribbl
@defmodule[br/define]
@margin-note{This module also exports the bindings from @racketmodname[br/macro].}
@defform[
(define-cases id
[pat body ...+] ...+)
@ -208,12 +199,6 @@ Define a function that behaves differently depending on how many arguments are s
]
@section{Macro}
@defmodule[br/macro #:packages ("beautiful-racket-lib" "beautiful-racket-macro")]
@defform*[
#:literals (syntax lambda stx)
[
@ -401,7 +386,7 @@ Like @racket[define-macro], but moves @racket[result-expr] into the lexical cont
@section{Syntax}
@defmodule[br/syntax #:packages ("beautiful-racket-lib" "beautiful-racket-macro")]
@defmodule[br/syntax]
@defform[(with-pattern ([pattern stx-expr] ...) body ...+)]{
Bind pattern variables within each @racket[pattern] by matching the pattern to its respective @racket[stx-expr]. These pattern variables can be used in later patternexpression clauses, or in @racket[body]. Uses the same pattern conventions as @racket[define-macro] (i.e., wildcard variables must be in @tt{CAPS}; everything else is treated as a literal).
@ -570,14 +555,14 @@ Get the line index in @racket[textbox] that contains @racket[position].
@defproc[(previous-line
[textbox (is-a?/c text%)]
[position (or/c exact-nonnegative-integer? #f)])
(or/c exact-nonnegative-integer? #f)]{
exact-nonnegative-integer?]{
Get the line index in @racket[textbox] of the line before the one that contains @racket[position].
}
@defproc[(next-line
[textbox (is-a?/c text%)]
[position (or/c exact-nonnegative-integer? #f)])
(or/c exact-nonnegative-integer? #f)]{
exact-nonnegative-integer?]{
Get the line index in @racket[textbox] of the line after the one that contains @racket[position].
}

@ -1,11 +1,9 @@
#lang info
(define collection 'multi)
(define version "1.6")
(define version "1.4")
;; base v6.7 dependency needs to be called 6.6.0.900
;; due to strange little bug in `raco pkg install`
(define deps '(["base" #:version "6.6.0.900"]
(define deps '(["base" #:version "6.3"]
"beautiful-racket-lib"
"beautiful-racket-demo"))

Loading…
Cancel
Save