Compare commits
20 Commits
main
...
unhygienic
Author | SHA1 | Date | |
---|---|---|---|
![]() |
e7f7270bdb | ||
![]() |
bbdf6dcc6e | ||
![]() |
096f87caab | ||
![]() |
f0a2d78036 | ||
![]() |
d3614be9fd | ||
![]() |
c8a2335574 | ||
![]() |
6fe2c2903a | ||
![]() |
67fcf59464 | ||
![]() |
25731ec47e | ||
![]() |
1c7d513cf4 | ||
![]() |
72142d5374 | ||
![]() |
7e1f74afce | ||
![]() |
9bd2f079ff | ||
![]() |
769128898b | ||
![]() |
ac539a0a33 | ||
![]() |
f20a10f0b8 | ||
![]() |
17ecdc23cf | ||
![]() |
98234ec643 | ||
![]() |
894d6ec8ff | ||
![]() |
8f19de52e9 |
24
.travis.yml
24
.travis.yml
|
@ -6,17 +6,27 @@ env:
|
||||||
global:
|
global:
|
||||||
- RACKET_DIR=~/racket
|
- RACKET_DIR=~/racket
|
||||||
matrix:
|
matrix:
|
||||||
- RACKET_VERSION=6.1.1
|
#- RACKET_VERSION=6.1.1
|
||||||
- RACKET_VERSION=6.2
|
#- RACKET_VERSION=6.2
|
||||||
- RACKET_VERSION=6.2.1
|
#- RACKET_VERSION=6.2.1
|
||||||
- RACKET_VERSION=6.3
|
#- RACKET_VERSION=6.3
|
||||||
- RACKET_VERSION=6.4
|
- RACKET_VERSION=6.4
|
||||||
- RACKET_VERSION=6.5
|
- RACKET_VERSION=6.5
|
||||||
|
- RACKET_VERSION=6.7
|
||||||
|
- RACKET_VERSION=6.8
|
||||||
|
- RACKET_VERSION=6.9
|
||||||
|
- RACKET_VERSION=6.10
|
||||||
|
- RACKET_VERSION=6.10.1
|
||||||
|
- RACKET_VERSION=6.11
|
||||||
|
- RACKET_VERSION=6.12
|
||||||
|
- RACKET_VERSION=7.0
|
||||||
|
- RACKET_VERSION=7.1
|
||||||
|
- RACKET_VERSION=7.2
|
||||||
- RACKET_VERSION=HEAD
|
- RACKET_VERSION=HEAD
|
||||||
|
|
||||||
matrix:
|
matrix:
|
||||||
allow_failures:
|
allow_failures:
|
||||||
- env: RACKET_VERSION=HEAD
|
# - env: RACKET_VERSION=HEAD
|
||||||
fast_finish: true
|
fast_finish: true
|
||||||
|
|
||||||
before_install:
|
before_install:
|
||||||
|
@ -30,7 +40,7 @@ install:
|
||||||
before_script:
|
before_script:
|
||||||
|
|
||||||
script:
|
script:
|
||||||
- raco pkg install --deps search-auto --link afl
|
- raco pkg install -j 2 --deps search-auto --link aful
|
||||||
- raco test -x -p afl
|
- raco test -r -p aful
|
||||||
|
|
||||||
after_script:
|
after_script:
|
||||||
|
|
11
README.md
11
README.md
|
@ -1,12 +1,17 @@
|
||||||
afl [](https://travis-ci.org/AlexKnauth/afl)
|
aful [](https://travis-ci.org/jsmaniac/aful)
|
||||||
===
|
===
|
||||||
|
|
||||||
a lang-extension for adding rackjure-like [anonymous function literals](http://www.greghendershott.com/rackjure/index.html#%28part._func-lit%29) to a language, based on at-exp and rackjure
|
a lang-extension for adding rackjure-like [anonymous function literals](http://www.greghendershott.com/rackjure/index.html#%28part._func-lit%29) to a language, based on at-exp and rackjure
|
||||||
|
|
||||||
documentation: http://pkg-build.racket-lang.org/doc/afl/index.html
|
documentation: http://pkg-build.racket-lang.org/doc/aful/index.html
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
```racket
|
```racket
|
||||||
#lang afl racket/base
|
#lang aful racket/base
|
||||||
|
(map #λ(+ % 1) '(1 2 3)) ;=> '(2 3 4)
|
||||||
|
```
|
||||||
|
|
||||||
|
```racket
|
||||||
|
#lang aful/unhygienic racket/base
|
||||||
(map #λ(+ % 1) '(1 2 3)) ;=> '(2 3 4)
|
(map #λ(+ % 1) '(1 2 3)) ;=> '(2 3 4)
|
||||||
```
|
```
|
||||||
|
|
|
@ -1,3 +0,0 @@
|
||||||
#lang info
|
|
||||||
|
|
||||||
(define scribblings '(["docs/afl.scrbl" ()]))
|
|
|
@ -1,9 +0,0 @@
|
||||||
#lang racket/base
|
|
||||||
|
|
||||||
(provide configure)
|
|
||||||
|
|
||||||
(require (only-in afl/reader use-afl-readtable))
|
|
||||||
|
|
||||||
(define (configure data)
|
|
||||||
(use-afl-readtable))
|
|
||||||
|
|
|
@ -4,52 +4,54 @@
|
||||||
scribble-code-examples
|
scribble-code-examples
|
||||||
(for-label (except-in racket/base
|
(for-label (except-in racket/base
|
||||||
read read-syntax)
|
read read-syntax)
|
||||||
(except-in afl/reader
|
(except-in aful/reader
|
||||||
read read-syntax)))
|
read read-syntax)))
|
||||||
|
@author[
|
||||||
|
"Alex Knauth"
|
||||||
|
@author+email["Suzanne Soy" "racket@suzanne.soy"]]
|
||||||
|
@title{aful}
|
||||||
|
|
||||||
@title{afl}
|
@;; example: @aful-code{(map #λ(+ % 1) '(1 2 3))}
|
||||||
|
@(define-syntax-rule @aful-code[stuff ...]
|
||||||
|
@code[#:lang "aful racket" stuff ...])
|
||||||
|
|
||||||
@;; example: @afl-code{(map #λ(+ % 1) '(1 2 3))}
|
source code: @url["https://github.com/jsmaniac/aful/"]
|
||||||
@(define-syntax-rule @afl-code[stuff ...]
|
|
||||||
@code[#:lang "afl racket" stuff ...])
|
|
||||||
|
|
||||||
source code: @url["https://github.com/AlexKnauth/afl"]
|
@section{#lang aful}
|
||||||
|
|
||||||
@section{#lang afl}
|
@defmodulelang[aful]{
|
||||||
|
The @racketmodname[aful] language is a lang-extension like @racketmodname[at-exp]
|
||||||
@defmodulelang[afl]{
|
|
||||||
The @racketmodname[afl] language is a lang-extension like @racketmodname[at-exp]
|
|
||||||
that adds @racketmodname[rackjure]-like anonymous function literals to a language.
|
that adds @racketmodname[rackjure]-like anonymous function literals to a language.
|
||||||
@margin-note{see @secref["func-lit" #:doc '(lib "rackjure/rackjure.scrbl")]}
|
@margin-note{see @secref["func-lit" #:doc '(lib "rackjure/rackjure.scrbl")]}
|
||||||
|
|
||||||
For example, @racket[@#,hash-lang[] @#,racketmodname[afl] @#,racketmodname[racket/base]]
|
For example, @racket[@#,hash-lang[] @#,racketmodname[aful] @#,racketmodname[racket/base]]
|
||||||
adds anonymous function literals to @racketmodname[racket/base], so that
|
adds anonymous function literals to @racketmodname[racket/base], so that
|
||||||
@codeblock{
|
@codeblock{
|
||||||
#lang afl racket/base}
|
#lang aful racket/base}
|
||||||
@code-examples[#:lang "afl racket/base" #:context #'here]|{
|
@code-examples[#:lang "aful racket/base" #:context #'here]|{
|
||||||
(map #λ(+ % 1) '(1 2 3))
|
(map #λ(+ % 1) '(1 2 3))
|
||||||
(map #λ(+ % %2) '(1 2 3) '(1 2 3))
|
(map #λ(+ % %2) '(1 2 3) '(1 2 3))
|
||||||
}|
|
}|
|
||||||
|
|
||||||
For the @racketmodname[afl] language to work properly for a module, the module
|
For the @racketmodname[aful] language to work properly for a module, the module
|
||||||
has to depend on @racketmodname[racket/base] in some way, although that does not
|
has to depend on @racketmodname[racket/base] in some way, although that does not
|
||||||
mean it has to explicitly require it or that the language it uses has to provide
|
mean it has to explicitly require it or that the language it uses has to provide
|
||||||
anything from it. It does mean that for instance
|
anything from it. It does mean that for instance
|
||||||
@racket[@#,hash-lang[] @#,racketmodname[afl] @#,racketmodname[racket/kernel]]
|
@racket[@#,hash-lang[] @#,racketmodname[aful] @#,racketmodname[racket/kernel]]
|
||||||
won't work properly.
|
won't work properly.
|
||||||
}
|
}
|
||||||
|
|
||||||
@section{afl/reader}
|
@section{aful/reader}
|
||||||
|
|
||||||
@defmodule[afl/reader]
|
@defmodule[aful/reader]
|
||||||
|
|
||||||
@deftogether[(@defproc[(afl-read [in input-port? (current-input-port)]
|
@deftogether[(@defproc[(aful-read [in input-port? (current-input-port)]
|
||||||
[#:arg-str arg-str string? (current-arg-string)]) any]{}
|
[#:arg-str arg-str string? (current-arg-string)]) any]{}
|
||||||
@defproc[(afl-read-syntax [source-name any/c (object-name in)]
|
@defproc[(aful-read-syntax [source-name any/c (object-name in)]
|
||||||
[in input-port? (current-input-port)]
|
[in input-port? (current-input-port)]
|
||||||
[#:arg-str arg-str string? (current-arg-string)])
|
[#:arg-str arg-str string? (current-arg-string)])
|
||||||
(or/c syntax? eof-object?)]{})]{
|
(or/c syntax? eof-object?)]{})]{
|
||||||
These procedures implement the @racketmodname[afl] reader. They do so by
|
These procedures implement the @racketmodname[aful] reader. They do so by
|
||||||
constructing a readtable based on the current one, and using that
|
constructing a readtable based on the current one, and using that
|
||||||
for reading.
|
for reading.
|
||||||
|
|
||||||
|
@ -57,31 +59,31 @@ The @racket[arg-str] argument lets you specify something else to use as a placeh
|
||||||
@racket[%].
|
@racket[%].
|
||||||
|
|
||||||
@examples[
|
@examples[
|
||||||
(require afl/reader)
|
(require aful/reader)
|
||||||
(afl-read (open-input-string "#λ(+ % %2)"))
|
(aful-read (open-input-string "#λ(+ % %2)"))
|
||||||
(afl-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
|
(aful-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
|
||||||
]
|
]
|
||||||
|
|
||||||
@racketmodname[afl/reader] also exports these functions under the names @racket[read] and
|
@racketmodname[aful/reader] also exports these functions under the names @racket[read] and
|
||||||
@racket[read-syntax].
|
@racket[read-syntax].
|
||||||
}
|
}
|
||||||
|
|
||||||
@defproc[(make-afl-readtable [orig-readtable readtable? (current-readtable)]
|
@defproc[(make-aful-readtable [orig-readtable readtable? (current-readtable)]
|
||||||
[#:outer-scope outer-scope (-> syntax? syntax?)]
|
[#:outer-scope outer-scope (-> syntax? syntax?)]
|
||||||
[#:arg-str arg-str string? (current-arg-string)]) readtable?]{
|
[#:arg-str arg-str string? (current-arg-string)]) readtable?]{
|
||||||
makes an @racketmodname[afl] readtable based on @racket[orig-readtable].
|
makes an @racketmodname[aful] readtable based on @racket[orig-readtable].
|
||||||
|
|
||||||
The @racket[outer-scope] argument should be a function that introduce scopes to preserve hygiene,
|
The @racket[outer-scope] argument should be a function that introduce scopes to preserve hygiene,
|
||||||
normally produced by @racket[make-syntax-introducer] and similar functions. For versions of racket
|
normally produced by @racket[make-syntax-introducer] and similar functions. For versions of racket
|
||||||
that support it, these should generally be specified as use-site scopes.
|
that support it, these should generally be specified as use-site scopes.
|
||||||
|
|
||||||
The @racket[arg-str] argument lets you specify something else to use as a placeholder instead of
|
The @racket[arg-str] argument lets you specify something else to use as a placeholder instead of
|
||||||
@racket[%], just like for @racket[afl-read].
|
@racket[%], just like for @racket[aful-read].
|
||||||
}
|
}
|
||||||
|
|
||||||
@defproc[(use-afl-readtable [orig-readtable readtable? (current-readtable)]
|
@defproc[(use-aful-readtable [orig-readtable readtable? (current-readtable)]
|
||||||
[#:arg-str arg-str string? (current-arg-string)]) void?]{
|
[#:arg-str arg-str string? (current-arg-string)]) void?]{
|
||||||
passes arguments to @racket[make-afl-readtable] and sets the @racket[current-readtable] parameter to
|
passes arguments to @racket[make-aful-readtable] and sets the @racket[current-readtable] parameter to
|
||||||
the resulting readtable.
|
the resulting readtable.
|
||||||
It also enables line counting for the @racket[current-input-port] via @racket[port-count-lines!].
|
It also enables line counting for the @racket[current-input-port] via @racket[port-count-lines!].
|
||||||
|
|
||||||
|
@ -90,15 +92,15 @@ This is mostly useful for the REPL.
|
||||||
@verbatim{
|
@verbatim{
|
||||||
Examples:
|
Examples:
|
||||||
|
|
||||||
> @afl-code{(require afl/reader)}
|
> @aful-code{(require aful/reader)}
|
||||||
> @afl-code{(use-afl-readtable)}
|
> @aful-code{(use-aful-readtable)}
|
||||||
> @afl-code{(map #λ(+ % %2) '(1 2 3) '(1 2 3))}
|
> @aful-code{(map #λ(+ % %2) '(1 2 3) '(1 2 3))}
|
||||||
@racketresult['(2 4 6)]
|
@racketresult['(2 4 6)]
|
||||||
> @afl-code{(use-afl-readtable #:arg-str "_")}
|
> @aful-code{(use-aful-readtable #:arg-str "_")}
|
||||||
> @afl-code{(map #λ(+ _ _2) '(1 2 3) '(1 2 3))}
|
> @aful-code{(map #λ(+ _ _2) '(1 2 3) '(1 2 3))}
|
||||||
@racketresult['(2 4 6)]
|
@racketresult['(2 4 6)]
|
||||||
}}
|
}}
|
||||||
|
|
||||||
@defparam[current-arg-string arg-str string?]{
|
@defparam[current-arg-string arg-str string?]{
|
||||||
a parameter that controls default values of the @racket[arg-str] arguments to @racket[afl-read] etc.
|
a parameter that controls default values of the @racket[arg-str] arguments to @racket[aful-read] etc.
|
||||||
}
|
}
|
3
aful/info.rkt
Normal file
3
aful/info.rkt
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
#lang info
|
||||||
|
|
||||||
|
(define scribblings '(["docs/aful.scrbl" ()]))
|
|
@ -13,7 +13,7 @@
|
||||||
(lambda (key default)
|
(lambda (key default)
|
||||||
(case key
|
(case key
|
||||||
[(configure-runtime)
|
[(configure-runtime)
|
||||||
(define config-vec '#[afl/lang/runtime-config configure #f])
|
(define config-vec '#[aful/lang/runtime-config configure #f])
|
||||||
(define other-config (other-get-info key default))
|
(define other-config (other-get-info key default))
|
||||||
(cond [(list? other-config) (cons config-vec other-config)]
|
(cond [(list? other-config) (cons config-vec other-config)]
|
||||||
[else (list config-vec)])]
|
[else (list config-vec)])]
|
|
@ -1,10 +1,10 @@
|
||||||
#lang lang-extension
|
#lang lang-extension
|
||||||
#:lang-extension afl make-afl-lang-reader
|
#:lang-extension aful make-aful-lang-reader
|
||||||
#:lang-reader afl-lang
|
#:lang-reader aful-lang
|
||||||
(require lang-reader/lang-reader
|
(require lang-reader/lang-reader
|
||||||
(only-in "../reader.rkt" wrap-reader))
|
(only-in "../reader.rkt" wrap-reader))
|
||||||
|
|
||||||
(define (make-afl-lang-reader lang-reader)
|
(define (make-aful-lang-reader lang-reader)
|
||||||
(define/lang-reader [-read -read-syntax -get-info] lang-reader)
|
(define/lang-reader [-read -read-syntax -get-info] lang-reader)
|
||||||
(make-lang-reader
|
(make-lang-reader
|
||||||
(wrap-reader -read)
|
(wrap-reader -read)
|
||||||
|
@ -12,7 +12,7 @@
|
||||||
(lambda args
|
(lambda args
|
||||||
(define stx (apply read-syntax args))
|
(define stx (apply read-syntax args))
|
||||||
(define old-prop (syntax-property stx 'module-language))
|
(define old-prop (syntax-property stx 'module-language))
|
||||||
(define new-prop `#(afl/lang/language-info get-language-info ,old-prop))
|
(define new-prop `#(aful/lang/language-info get-language-info ,old-prop))
|
||||||
(syntax-property stx 'module-language new-prop)))
|
(syntax-property stx 'module-language new-prop)))
|
||||||
-get-info))
|
-get-info))
|
||||||
|
|
9
aful/lang/runtime-config.rkt
Normal file
9
aful/lang/runtime-config.rkt
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide configure)
|
||||||
|
|
||||||
|
(require (only-in aful/reader use-aful-readtable))
|
||||||
|
|
||||||
|
(define (configure data)
|
||||||
|
(use-aful-readtable))
|
||||||
|
|
|
@ -1,14 +1,15 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide make-afl-readtable
|
(provide make-aful-readtable
|
||||||
afl-read
|
aful-read
|
||||||
afl-read-syntax
|
aful-read-syntax
|
||||||
wrap-reader
|
wrap-reader
|
||||||
use-afl-readtable
|
wrap-reader-unhygienic
|
||||||
|
use-aful-readtable
|
||||||
current-arg-string
|
current-arg-string
|
||||||
(rename-out
|
(rename-out
|
||||||
[afl-read read]
|
[aful-read read]
|
||||||
[afl-read-syntax read-syntax])
|
[aful-read-syntax read-syntax])
|
||||||
)
|
)
|
||||||
|
|
||||||
(require racket/match
|
(require racket/match
|
||||||
|
@ -18,6 +19,9 @@
|
||||||
racket/function
|
racket/function
|
||||||
syntax/srcloc
|
syntax/srcloc
|
||||||
hygienic-reader-extension/extend-reader
|
hygienic-reader-extension/extend-reader
|
||||||
|
"scribble-enhanced.rkt"
|
||||||
|
phc-toolkit/stx
|
||||||
|
"unhygienic/hygienic-reader-extension--extend-reader--unhygienic.rkt"
|
||||||
(for-meta -10 racket/base)
|
(for-meta -10 racket/base)
|
||||||
(for-meta -9 racket/base)
|
(for-meta -9 racket/base)
|
||||||
(for-meta -8 racket/base)
|
(for-meta -8 racket/base)
|
||||||
|
@ -45,19 +49,32 @@
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit))
|
(require rackunit))
|
||||||
|
|
||||||
(define (afl-read [in (current-input-port)] #:arg-str [arg-str (current-arg-string)])
|
(define (aful-read [in (current-input-port)] #:arg-str [arg-str (current-arg-string)])
|
||||||
(parameterize ([current-arg-string arg-str])
|
(parameterize ([current-arg-string arg-str])
|
||||||
((wrap-reader read) in)))
|
((wrap-reader read) in)))
|
||||||
|
|
||||||
(define (afl-read-syntax [src (object-name (current-input-port))] [in (current-input-port)]
|
(define (aful-read-syntax [src (object-name (current-input-port))] [in (current-input-port)]
|
||||||
#:arg-str [arg-str (current-arg-string)])
|
#:arg-str [arg-str (current-arg-string)])
|
||||||
(parameterize ([current-arg-string arg-str])
|
(parameterize ([current-arg-string arg-str])
|
||||||
((wrap-reader read-syntax) src in)))
|
((wrap-reader read-syntax) src in)))
|
||||||
|
|
||||||
(define (wrap-reader p)
|
(define (wrap-reader p)
|
||||||
(extend-reader p make-afl-readtable))
|
(extend-reader p make-aful-readtable))
|
||||||
|
|
||||||
(define (make-afl-readtable [orig-rt (current-readtable)]
|
(require syntax/strip-context)
|
||||||
|
(define ((wrap-reader-unhygienic p) . p-args)
|
||||||
|
(strip-context
|
||||||
|
(apply (extend-reader-unhygienic p
|
||||||
|
(λ ([orig-rt (current-readtable)]
|
||||||
|
#:outer-scope outer-scope
|
||||||
|
#:arg-str [arg-str (current-arg-string)])
|
||||||
|
(make-aful-readtable orig-rt
|
||||||
|
#:outer-scope (λ (stx [mode 'flip]) stx)
|
||||||
|
#:arg-str arg-str))
|
||||||
|
#:hygiene? #f)
|
||||||
|
p-args)))
|
||||||
|
|
||||||
|
(define (make-aful-readtable [orig-rt (current-readtable)]
|
||||||
#:outer-scope outer-scope
|
#:outer-scope outer-scope
|
||||||
#:arg-str [arg-str (current-arg-string)])
|
#:arg-str [arg-str (current-arg-string)])
|
||||||
(define reader-proc (make-reader-proc orig-rt outer-scope #:arg-str arg-str))
|
(define reader-proc (make-reader-proc orig-rt outer-scope #:arg-str arg-str))
|
||||||
|
@ -67,19 +84,19 @@
|
||||||
[rt (make-readtable rt #\l 'dispatch-macro reader-proc)])
|
[rt (make-readtable rt #\l 'dispatch-macro reader-proc)])
|
||||||
rt))
|
rt))
|
||||||
|
|
||||||
(define (use-afl-readtable [orig-rt (current-readtable)] #:arg-str [arg-str (current-arg-string)])
|
(define (use-aful-readtable [orig-rt (current-readtable)] #:arg-str [arg-str (current-arg-string)])
|
||||||
(port-count-lines! (current-input-port))
|
(port-count-lines! (current-input-port))
|
||||||
(current-readtable (make-afl-readtable orig-rt #:outer-scope identity #:arg-str arg-str)))
|
(current-readtable (make-aful-readtable orig-rt #:outer-scope identity #:arg-str arg-str)))
|
||||||
|
|
||||||
(define current-arg-string (make-parameter "%"))
|
(define current-arg-string (make-parameter "%"))
|
||||||
|
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(check-equal? (afl-read (open-input-string "#λ(+ % %2)"))
|
(check-equal? (aful-read (open-input-string "#λ(+ % %2)"))
|
||||||
'(lambda (%1 %2)
|
'(lambda (%1 %2)
|
||||||
(define-syntax % (make-rename-transformer #'%1))
|
(define-syntax % (make-rename-transformer #'%1))
|
||||||
(+ % %2)))
|
(+ % %2)))
|
||||||
(check-equal? (afl-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
|
(check-equal? (aful-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
|
||||||
'(lambda (_1 _2)
|
'(lambda (_1 _2)
|
||||||
(define-syntax _ (make-rename-transformer #'_1))
|
(define-syntax _ (make-rename-transformer #'_1))
|
||||||
(+ _ _2)))
|
(+ _ _2)))
|
||||||
|
@ -143,10 +160,14 @@
|
||||||
[% (string->id stx* arg-str)]
|
[% (string->id stx* arg-str)]
|
||||||
[%1 (string->id stx* arg-str "1")]
|
[%1 (string->id stx* arg-str "1")]
|
||||||
[body stx*])
|
[body stx*])
|
||||||
(syntax/loc loc-stx
|
(syntax-property
|
||||||
|
(syntax/top-loc loc-stx
|
||||||
(lambda args
|
(lambda args
|
||||||
(define-syntax % (make-rename-transformer #'%1))
|
(define-syntax % (make-rename-transformer #'%1))
|
||||||
body))))
|
body))
|
||||||
|
'scribble-render-as
|
||||||
|
aful-scribble-render)
|
||||||
|
))
|
||||||
stx)))
|
stx)))
|
||||||
|
|
||||||
(define (orig stx)
|
(define (orig stx)
|
20
aful/scribble-enhanced.rkt
Normal file
20
aful/scribble-enhanced.rkt
Normal file
|
@ -0,0 +1,20 @@
|
||||||
|
#lang racket
|
||||||
|
(provide aful-scribble-render)
|
||||||
|
|
||||||
|
(require phc-toolkit/stx)
|
||||||
|
|
||||||
|
(define (aful-scribble-render self id code typeset-code uncode d->s stx-prop)
|
||||||
|
(syntax-case self ()
|
||||||
|
[(_ _ _ body)
|
||||||
|
; #λ(body) reads as:
|
||||||
|
; (lambda args
|
||||||
|
; (define-syntax % (make-rename-transformer #'%1))
|
||||||
|
; body)
|
||||||
|
(with-syntax ([uncode (datum->syntax uncode (syntax-e uncode) self)])
|
||||||
|
(syntax/top-loc self
|
||||||
|
((uncode(let ()
|
||||||
|
(local-require scribble-enhanced/with-manual)
|
||||||
|
(seclink "_lang_aful"
|
||||||
|
#:doc '(lib "aful/docs/aful.scrbl")
|
||||||
|
(tt "#λ"))))
|
||||||
|
body)))]))
|
|
@ -1,4 +1,4 @@
|
||||||
#lang afl at-exp racket/base
|
#lang aful at-exp racket/base
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(check-equal? (map #λ(+ % 1) '(1 2 3))
|
(check-equal? (map #λ(+ % 1) '(1 2 3))
|
||||||
'(2 3 4))
|
'(2 3 4))
|
|
@ -1,4 +1,4 @@
|
||||||
#lang afl racket/base
|
#lang aful racket/base
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(check-equal? (map #λ(+ % 1) '(1 2 3))
|
(check-equal? (map #λ(+ % 1) '(1 2 3))
|
|
@ -1,4 +1,4 @@
|
||||||
#lang afl scribble/base
|
#lang aful scribble/base
|
||||||
@(require rackunit)
|
@(require rackunit)
|
||||||
@(check-equal? @#λ@title{@%}{This is a Title}
|
@(check-equal? @#λ@title{@%}{This is a Title}
|
||||||
@title{This is a Title})
|
@title{This is a Title})
|
|
@ -0,0 +1,27 @@
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
;; Copied and adjusted from
|
||||||
|
;; https://github.com/AlexKnauth/hygienic-reader-extension
|
||||||
|
;; /blob/master/hygienic-reader-extension/extend-reader.rkt
|
||||||
|
|
||||||
|
(provide extend-reader-unhygienic)
|
||||||
|
|
||||||
|
;; extend-reader : (-> (-> A ... Any)
|
||||||
|
;; (-> Readtable #:outer-scope (-> Syntax Syntax) Readtable)
|
||||||
|
;; (-> A ... Any))
|
||||||
|
(define (extend-reader-unhygienic proc extend-readtable #:hygiene? [hygiene? #t])
|
||||||
|
(lambda args
|
||||||
|
(define orig-readtable (current-readtable))
|
||||||
|
(define outer-scope (make-syntax-introducer/use-site))
|
||||||
|
(parameterize ([current-readtable (extend-readtable orig-readtable #:outer-scope outer-scope)])
|
||||||
|
(define stx (apply proc args))
|
||||||
|
(if (and (syntax? stx) hygiene?)
|
||||||
|
(outer-scope stx)
|
||||||
|
stx))))
|
||||||
|
|
||||||
|
;; make-syntax-introducer/use-site : (-> (-> Syntax Syntax))
|
||||||
|
(define (make-syntax-introducer/use-site)
|
||||||
|
(cond [(procedure-arity-includes? make-syntax-introducer 1)
|
||||||
|
(make-syntax-introducer #t)]
|
||||||
|
[else
|
||||||
|
(make-syntax-introducer)]))
|
21
aful/unhygienic/lang/language-info.rkt
Normal file
21
aful/unhygienic/lang/language-info.rkt
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide get-language-info)
|
||||||
|
|
||||||
|
(require racket/match)
|
||||||
|
|
||||||
|
(define (get-language-info data)
|
||||||
|
(define other-get-info
|
||||||
|
(match data
|
||||||
|
[(vector mod sym data2)
|
||||||
|
((dynamic-require mod sym) data2)]
|
||||||
|
[_ (lambda (key default) default)]))
|
||||||
|
(lambda (key default)
|
||||||
|
(case key
|
||||||
|
[(configure-runtime)
|
||||||
|
(define config-vec '#[aful/lang/runtime-config configure #f])
|
||||||
|
(define other-config (other-get-info key default))
|
||||||
|
(cond [(list? other-config) (cons config-vec other-config)]
|
||||||
|
[else (list config-vec)])]
|
||||||
|
[else (other-get-info key default)])))
|
||||||
|
|
18
aful/unhygienic/lang/reader.rkt
Normal file
18
aful/unhygienic/lang/reader.rkt
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
#lang lang-extension
|
||||||
|
#:lang-extension aful make-aful-lang-reader
|
||||||
|
#:lang-reader aful-lang
|
||||||
|
(require lang-reader/lang-reader
|
||||||
|
(only-in "../../reader.rkt" wrap-reader-unhygienic))
|
||||||
|
|
||||||
|
(define (make-aful-lang-reader lang-reader)
|
||||||
|
(define/lang-reader [-read -read-syntax -get-info] lang-reader)
|
||||||
|
(make-lang-reader
|
||||||
|
(wrap-reader-unhygienic -read)
|
||||||
|
(let ([read-syntax (wrap-reader-unhygienic -read-syntax)])
|
||||||
|
(lambda args
|
||||||
|
(define stx (apply read-syntax args))
|
||||||
|
(define old-prop (syntax-property stx 'module-language))
|
||||||
|
(define new-prop `#(aful/lang/language-info get-language-info ,old-prop))
|
||||||
|
(syntax-property stx 'module-language new-prop)))
|
||||||
|
-get-info))
|
||||||
|
|
9
aful/unhygienic/lang/runtime-config.rkt
Normal file
9
aful/unhygienic/lang/runtime-config.rkt
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide configure)
|
||||||
|
|
||||||
|
(require (only-in aful/reader use-aful-readtable))
|
||||||
|
|
||||||
|
(define (configure data)
|
||||||
|
(use-aful-readtable))
|
||||||
|
|
4
info.rkt
4
info.rkt
|
@ -8,6 +8,9 @@
|
||||||
"at-exp-lib"
|
"at-exp-lib"
|
||||||
"rackjure"
|
"rackjure"
|
||||||
"rackunit-lib"
|
"rackunit-lib"
|
||||||
|
"phc-toolkit"
|
||||||
|
"scribble-enhanced"
|
||||||
|
"scribble-lib"
|
||||||
))
|
))
|
||||||
|
|
||||||
(define build-deps
|
(define build-deps
|
||||||
|
@ -15,5 +18,6 @@
|
||||||
"racket-doc"
|
"racket-doc"
|
||||||
"scribble-doc"
|
"scribble-doc"
|
||||||
"scribble-code-examples"
|
"scribble-code-examples"
|
||||||
|
"scribble-doc"
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user